home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 8: LINUX Games / Linux Cubed Series 8 - LINUX Games.iso / games / muds / lpmud312.tar / lpmud312 / lang.y < prev    next >
Text File  |  1993-01-11  |  73KB  |  2,553 lines

  1. %{
  2. # line 3 "prelang.y"
  3. /* The above line is to give proper line number references. Please mail me
  4.  * if your compiler complains about it.
  5.  */
  6. /*
  7.  * This is the grammar definition of LPC. The token table is built
  8.  * automatically by make_func. The lang.y is constructed from this file,
  9.  * the generated token list and post_lang.y. The reason of this is that there
  10.  * is no #include-statment that yacc recognizes.
  11.  */
  12. #include <string.h>
  13. #include <stdio.h>
  14. #include <memory.h>
  15. #if defined(sun)
  16. #include <alloca.h>
  17. #endif
  18.  
  19. #include "lint.h"
  20. #include "interpret.h"
  21. #include "object.h"
  22. #include "exec.h"
  23. #include "config.h"
  24. #include "instrs.h"
  25. #include "incralloc.h"
  26. #include "switch.h"
  27.  
  28. #if defined(__GNUC__) && !defined(lint) && !defined(DEBUG)
  29. #define INLINE inline
  30. #else
  31. #define INLINE
  32. #endif
  33.  
  34. #define YYMAXDEPTH    600
  35.  
  36. /* NUMPAREAS areas are saved with the program code after compilation.
  37.  */
  38. #define A_PROGRAM        0
  39. #define A_FUNCTIONS        1
  40. #define A_STRINGS        2
  41. #define A_VARIABLES        3
  42. #define A_LINENUMBERS        4
  43. #define A_INHERITS        5
  44. #define A_ARGUMENT_TYPES    6
  45. #define A_ARGUMENT_INDEX    7
  46. #define NUMPAREAS        8
  47. #define A_CASE_NUMBERS        8
  48. #define A_CASE_STRINGS        9
  49. #define A_CASE_LABELS           10
  50. #define NUMAREAS           11
  51.  
  52. #define BREAK_ON_STACK        0x40000
  53. #define BREAK_FROM_CASE        0x80000
  54.  
  55. /* make shure that this struct has a size that is a power of two */
  56. struct case_heap_entry { int key; short addr; short line; };
  57. #define CASE_HEAP_ENTRY_ALIGN(offset) offset &= -sizeof(struct case_heap_entry)
  58.  
  59. static struct mem_block mem_block[NUMAREAS];
  60.  
  61. /*
  62.  * Some good macros to have.
  63.  */
  64.  
  65. #define BASIC_TYPE(e,t) ((e) == TYPE_ANY ||\
  66.              (e) == (t) ||\
  67.              (t) == TYPE_ANY)
  68.  
  69. #define TYPE(e,t) (BASIC_TYPE((e) & TYPE_MOD_MASK, (t) & TYPE_MOD_MASK) ||\
  70.            (((e) & TYPE_MOD_POINTER) && ((t) & TYPE_MOD_POINTER) &&\
  71.             BASIC_TYPE((e) & (TYPE_MOD_MASK & ~TYPE_MOD_POINTER),\
  72.                    (t) & (TYPE_MOD_MASK & ~TYPE_MOD_POINTER))))
  73.  
  74. #define FUNCTION(n) ((struct function *)mem_block[A_FUNCTIONS].block + (n))
  75. #define VARIABLE(n) ((struct variable *)mem_block[A_VARIABLES].block + (n))
  76.  
  77. #define align(x) (((x) + 3) & ~3)
  78.  
  79. /*
  80.  * If the type of the function is given, then strict types are
  81.  * checked and required.
  82.  */
  83. static int exact_types;
  84. extern int pragma_strict_types;    /* Maintained by lex.c */
  85. extern int pragma_save_types;    /* Also maintained by lex.c */
  86. int approved_object;        /* How I hate all these global variables */
  87.  
  88. extern int total_num_prog_blocks, total_prog_block_size;
  89.  
  90. extern int num_parse_error;
  91. extern int d_flag;
  92. static int heart_beat;        /* Number of the heart beat function */
  93.  
  94. static int current_break_address;
  95. static int current_continue_address;
  96. static int current_case_number_heap;
  97. static int current_case_string_heap;
  98. #define SOME_NUMERIC_CASE_LABELS 0x40000
  99. #define NO_STRING_CASE_LABELS    0x80000
  100. static int zero_case_label;
  101. static int current_type;
  102.  
  103. static int last_push_indexed;
  104. static int last_push_local;
  105. static int last_push_identifier;
  106.  
  107. /*
  108.  * There is always function starting at address 0, which will execute
  109.  * the initialization code. This code is spread all over the program,
  110.  * with jumps to next initializer. The next variable keeps track of
  111.  * the previous jump. After the last initializer, the jump will be changed
  112.  * into a return(0) statement instead.
  113.  *
  114.  * A function named '__INIT' will be defined, which will contain the
  115.  * initialization code. If there was no initialization code, then the
  116.  * function will not be defined. That is the usage of the
  117.  * first_last_initializer_end variable.
  118.  *
  119.  * When inheriting from another object, a call will automatically be made
  120.  * to call __INIT in that code from the current __INIT.
  121.  */
  122. static int last_initializer_end;
  123. static int first_last_initializer_end;
  124.  
  125. static struct program NULL_program; /* marion - clean neat empty struct */
  126.  
  127. void epilog();
  128. static int check_declared PROT((char *str));
  129. static void prolog();
  130. static char *get_two_types PROT((int type1, int type2));
  131. void free_all_local_names(),
  132.     add_local_name PROT((char *, int)), smart_log PROT((char *, int, char *));
  133. extern int yylex();
  134. static int verify_declared PROT((char *));
  135. static void copy_variables();
  136. static int copy_functions PROT((struct program *, int type));
  137. void type_error PROT((char *, int));
  138.  
  139. char *xalloc(), *string_copy();
  140.  
  141. extern int current_line;
  142. /*
  143.  * 'inherit_file' is used as a flag. If it is set to a string
  144.  * after yyparse(), this string should be loaded as an object,
  145.  * and the original object must be loaded again.
  146.  */
  147. extern char *current_file, *inherit_file;
  148.  
  149. /*
  150.  * The names and types of arguments and auto variables.
  151.  */
  152. char *local_names[MAX_LOCAL];
  153. unsigned short type_of_locals[MAX_LOCAL];
  154. int current_number_of_locals = 0;
  155. int current_break_stack_need = 0  ,max_break_stack_need = 0;
  156.  
  157. /*
  158.  * The types of arguments when calling functions must be saved,
  159.  * to be used afterwards for checking. And because function calls
  160.  * can be done as an argument to a function calls,
  161.  * a stack of argument types is needed. This stack does not need to
  162.  * be freed between compilations, but will be reused.
  163.  */
  164. static struct mem_block type_of_arguments;
  165.  
  166. struct program *prog;    /* Is returned to the caller of yyparse */
  167.  
  168. /*
  169.  * Compare two types, and return true if they are compatible.
  170.  */
  171. static int compatible_types(t1, t2)
  172.     int t1, t2;
  173. {
  174.     if (t1 == TYPE_UNKNOWN || t2 == TYPE_UNKNOWN)
  175.     return 0;
  176.     if (t1 == t2)
  177.     return 1;
  178.     if (t1 == TYPE_ANY || t2 == TYPE_ANY)
  179.     return 1;
  180.     if ((t1 & TYPE_MOD_POINTER) && (t2 & TYPE_MOD_POINTER)) {
  181.     if ((t1 & TYPE_MOD_MASK) == (TYPE_ANY|TYPE_MOD_POINTER) ||
  182.         (t2 & TYPE_MOD_MASK) == (TYPE_ANY|TYPE_MOD_POINTER))
  183.         return 1;
  184.     }
  185.     return 0;
  186. }
  187.  
  188. /*
  189.  * Add another argument type to the argument type stack
  190.  */
  191. INLINE
  192. static void add_arg_type(type)
  193.     unsigned short type;
  194. {
  195.     struct mem_block *mbp = &type_of_arguments;
  196.     while (mbp->current_size + sizeof type > mbp->max_size) {
  197.     mbp->max_size <<= 1;
  198.     mbp->block = realloc((char *)mbp->block, mbp->max_size);
  199.     }
  200.     memcpy(mbp->block + mbp->current_size, &type, sizeof type);
  201.     mbp->current_size += sizeof type;
  202. }
  203.  
  204. /*
  205.  * Pop the argument type stack 'n' elements.
  206.  */
  207. INLINE
  208. static void pop_arg_stack(n)
  209.     int n;
  210. {
  211.     type_of_arguments.current_size -= sizeof (unsigned short) * n;
  212. }
  213.  
  214. /*
  215.  * Get type of argument number 'arg', where there are
  216.  * 'n' arguments in total in this function call. Argument
  217.  * 0 is the first argument.
  218.  */
  219. INLINE
  220. int get_argument_type(arg, n)
  221.     int arg, n;
  222. {
  223.     return
  224.     ((unsigned short *)
  225.      (type_of_arguments.block + type_of_arguments.current_size))[arg - n];
  226. }
  227.  
  228. INLINE
  229. static void add_to_mem_block(n, data, size)
  230.     int n, size;
  231.     char *data;
  232. {
  233.     struct mem_block *mbp = &mem_block[n];
  234.     while (mbp->current_size + size > mbp->max_size) {
  235.     mbp->max_size <<= 1;
  236.     mbp->block = realloc((char *)mbp->block, mbp->max_size);
  237.     }
  238.     memcpy(mbp->block + mbp->current_size, data, size);
  239.     mbp->current_size += size;
  240. }
  241.  
  242. static void ins_byte(b)
  243.     char b;
  244. {
  245.     add_to_mem_block(A_PROGRAM, &b, 1);
  246. }
  247.  
  248. /*
  249.  * Store a 2 byte number. It is stored in such a way as to be sure
  250.  * that correct byte order is used, regardless of machine architecture.
  251.  * Also beware that some machines can't write a word to odd addresses.
  252.  */
  253. static void ins_short(l)
  254.     short l;
  255. {
  256.     add_to_mem_block(A_PROGRAM, (char *)&l + 0, 1);
  257.     add_to_mem_block(A_PROGRAM, (char *)&l + 1, 1);
  258. }
  259.  
  260. static void upd_short(offset, l)
  261.     int offset;
  262.     short l;
  263. {
  264.     mem_block[A_PROGRAM].block[offset + 0] = ((char *)&l)[0];
  265.     mem_block[A_PROGRAM].block[offset + 1] = ((char *)&l)[1];
  266. }
  267.  
  268. static short read_short(offset)
  269.     int offset;
  270. {
  271.     short l;
  272.  
  273.     ((char *)&l)[0] = mem_block[A_PROGRAM].block[offset + 0];
  274.     ((char *)&l)[1] = mem_block[A_PROGRAM].block[offset + 1];
  275.     return l;
  276. }
  277.  
  278. /*
  279.  * Store a 4 byte number. It is stored in such a way as to be sure
  280.  * that correct byte order is used, regardless of machine architecture.
  281.  */
  282. static void ins_long(l)
  283.     int l;
  284. {
  285.     add_to_mem_block(A_PROGRAM, (char *)&l+0, 1);
  286.     add_to_mem_block(A_PROGRAM, (char *)&l+1, 1);
  287.     add_to_mem_block(A_PROGRAM, (char *)&l+2, 1);
  288.     add_to_mem_block(A_PROGRAM, (char *)&l+3, 1);
  289. }
  290.  
  291. static void ins_f_byte(b)
  292.     unsigned int b;
  293. {
  294.     ins_byte((char)(b - F_OFFSET));
  295. }
  296.  
  297. /*
  298.  * Return the index of the function found, otherwise -1.
  299.  */
  300. static int defined_function(s)
  301.     char *s;
  302. {
  303.     int offset;
  304.     struct function *funp;
  305.  
  306.     for (offset = 0; offset < mem_block[A_FUNCTIONS].current_size;
  307.      offset += sizeof (struct function)) {
  308.     funp = (struct function *)&mem_block[A_FUNCTIONS].block[offset];
  309.     if (funp->flags & NAME_HIDDEN)
  310.         continue;
  311.         if (strcmp(funp->name, s) == 0)
  312.         return offset / sizeof (struct function);
  313.     }
  314.     return -1;
  315. }
  316.  
  317. /*
  318.  * A mechanism to remember addresses on a stack. The size of the stack is
  319.  * defined in config.h.
  320.  */
  321. static int comp_stackp;
  322. static int comp_stack[COMPILER_STACK_SIZE];
  323.  
  324. static void push_address() {
  325.     if (comp_stackp >= COMPILER_STACK_SIZE) {
  326.     yyerror("Compiler stack overflow");
  327.     comp_stackp++;
  328.     return;
  329.     }
  330.     comp_stack[comp_stackp++] = mem_block[A_PROGRAM].current_size;
  331. }
  332.  
  333. static void push_explicit(address)
  334.     int address;
  335. {
  336.     if (comp_stackp >= COMPILER_STACK_SIZE) {
  337.     yyerror("Compiler stack overflow");
  338.     comp_stackp++;
  339.     return;
  340.     }
  341.     comp_stack[comp_stackp++] = address;
  342. }
  343.  
  344. static int pop_address() {
  345.     if (comp_stackp == 0)
  346.     fatal("Compiler stack underflow.\n");
  347.     if (comp_stackp > COMPILER_STACK_SIZE) {
  348.     --comp_stackp;
  349.     return 0;
  350.     }
  351.     return comp_stack[--comp_stackp];
  352. }
  353.  
  354. /*
  355.  * Patch a function definition of an inherited function, to what it really
  356.  * should be.
  357.  * The name of the function can be one of:
  358.  *    object::name
  359.  *    ::name
  360.  *    name
  361.  * Where 'object' is the name of the superclass.
  362.  */
  363. static void find_inherited(funp)
  364.     struct function *funp;
  365. {
  366.     int i;
  367.     struct inherit *ip;
  368.     int num_inherits, super_length;
  369.     char *real_name, *super_name = 0, *p;
  370.  
  371.     real_name = funp->name;
  372.     if (real_name[0] == ':')
  373.     real_name = real_name + 2;    /* There will be exactly two ':' */
  374.     else if (p = strchr(real_name, ':')) {
  375.     real_name = p+2;
  376.     super_name = funp->name;
  377.     super_length = real_name - super_name - 2;
  378.     }
  379.     num_inherits = mem_block[A_INHERITS].current_size /
  380.     sizeof (struct inherit);
  381.     ip = (struct inherit *)mem_block[A_INHERITS].block;
  382.     for (; num_inherits > 0; ip++, num_inherits--) {
  383.     if (super_name) {
  384.         int l = strlen(ip->prog->name);    /* Including .c */
  385.         if (l - 2 < super_length)
  386.         continue;
  387.         if (strncmp(super_name, ip->prog->name + l - 2 - super_length,
  388.             super_length) != 0)
  389.         continue;
  390.     }
  391.     for (i=0; i < ip->prog->num_functions; i++) {
  392.         if (ip->prog->functions[i].flags & (NAME_UNDEFINED|NAME_HIDDEN))
  393.         continue;
  394.         if (strcmp(ip->prog->functions[i].name, real_name) != 0)
  395.         continue;
  396.         funp->offset = ip - (struct inherit *)mem_block[A_INHERITS].block;
  397.         funp->flags = ip->prog->functions[i].flags | NAME_INHERITED;
  398.         funp->num_local = ip->prog->functions[i].num_local;
  399.         funp->num_arg = ip->prog->functions[i].num_arg;
  400.         funp->type = ip->prog->functions[i].type;
  401.         funp->function_index_offset = i;
  402.         return;
  403.     }
  404.     }
  405.     return;
  406. }
  407.  
  408. /*
  409.  * Define a new function. Note that this function is called at least twice
  410.  * for alll function definitions. First as a prototype, then as the real
  411.  * function. Thus, there are tests to avoid generating error messages more
  412.  * than once by looking at (flags & NAME_PROTOTYPE).
  413.  */
  414. static int define_new_function(name, num_arg, num_local, offset, flags, type)
  415.     char *name;
  416.     int num_arg, num_local;
  417.     int offset, flags, type;
  418. {
  419.     int num;
  420.     struct function fun;
  421.     unsigned short argument_start_index;
  422.  
  423.     num = defined_function(name);
  424.     if (num >= 0) {
  425.     struct function *funp;
  426.  
  427.     /*
  428.      * The function was already defined. It may be one of several reasons:
  429.      *
  430.      * 1.    There has been a prototype.
  431.      * 2.    There was the same function defined by inheritance.
  432.      * 3.    This function has been called, but not yet defined.
  433.      * 4.    The function is doubly defined.
  434.      * 5.    A "late" prototype has been encountered.
  435.      */
  436.     funp = (struct function *)(mem_block[A_FUNCTIONS].block) + num;
  437.     if (!(funp->flags & NAME_UNDEFINED) &&
  438.         !(flags & NAME_PROTOTYPE) &&
  439.         !(funp->flags & NAME_INHERITED))
  440.     {
  441.         char buff[500];
  442.         sprintf(buff, "Redeclaration of function %s.", name);
  443.         yyerror(buff);
  444.         return num;
  445.     }
  446.     /*
  447.      * It was either an undefined but used funtion, or an inherited
  448.      * function. In both cases, we now consider this to be THE new
  449.      * definition. It might also have been a prototype to an already
  450.      * defined function.
  451.      *
  452.      * Check arguments only when types are supposed to be tested,
  453.      * and if this function really has been defined already.
  454.      *
  455.      * 'nomask' functions may not be redefined.
  456.      */
  457.     if ((funp->type & TYPE_MOD_NO_MASK) &&
  458.         !(funp->flags & NAME_PROTOTYPE) &&
  459.         !(flags & NAME_PROTOTYPE))
  460.     {
  461.         char *p = (char *)alloca(80 + strlen(name));
  462.         sprintf(p, "Illegal to redefine 'nomask' function \"%s\"",name);
  463.         yyerror(p);
  464.     }
  465.     if (exact_types && funp->type != TYPE_UNKNOWN) {
  466.         int i;
  467.         if (funp->num_arg != num_arg && !(funp->type & TYPE_MOD_VARARGS))
  468.         yyerror("Incorrect number of arguments.");
  469.         else if (!(funp->flags & NAME_STRICT_TYPES))
  470.         yyerror("Called function not compiled with type testing.");
  471.         else {
  472.         /* Now check that argument types wasn't changed. */
  473.         for (i=0; i < num_arg; i++) {
  474.         }
  475.         }
  476.     }
  477.     /* If it was yet another prototype, then simply return. */
  478.     if (flags & NAME_PROTOTYPE)
  479.         return num;
  480.     funp->num_arg = num_arg;
  481.     funp->num_local = num_local;
  482.     funp->flags = flags;
  483.     funp->offset = offset;
  484.     funp->function_index_offset = 0;
  485.     funp->type = type;
  486.     if (exact_types)
  487.         funp->flags |= NAME_STRICT_TYPES;
  488.     return num;
  489.     }
  490.     if (strcmp(name, "heart_beat") == 0)
  491.     heart_beat = mem_block[A_FUNCTIONS].current_size /
  492.         sizeof (struct function);
  493.     fun.name = make_shared_string(name);
  494.     fun.offset = offset;
  495.     fun.flags = flags;
  496.     fun.num_arg = num_arg;
  497.     fun.num_local = num_local;
  498.     fun.function_index_offset = 0;
  499.     fun.type = type;
  500.     if (exact_types)
  501.     fun.flags |= NAME_STRICT_TYPES;
  502.     num = mem_block[A_FUNCTIONS].current_size / sizeof fun;
  503.     /* Number of local variables will be updated later */
  504.     add_to_mem_block(A_FUNCTIONS, (char *)&fun, sizeof fun);
  505.  
  506.     if (exact_types == 0 || num_arg == 0) {
  507.     argument_start_index = INDEX_START_NONE;
  508.     } else {
  509.     int i;
  510.  
  511.     /*
  512.      * Save the start of argument types.
  513.      */
  514.     argument_start_index =
  515.         mem_block[A_ARGUMENT_TYPES].current_size /
  516.         sizeof (unsigned short);
  517.     for (i=0; i < num_arg; i++) {
  518.         add_to_mem_block(A_ARGUMENT_TYPES, &type_of_locals[i],
  519.                  sizeof type_of_locals[i]);
  520.     }
  521.     }
  522.     add_to_mem_block(A_ARGUMENT_INDEX, &argument_start_index,
  523.              sizeof argument_start_index);
  524.     return num;
  525. }
  526.  
  527. static void define_variable(name, type, flags)
  528.     char *name;
  529.     int type;
  530.     int flags;
  531. {
  532.     struct variable dummy;
  533.     int n;
  534.  
  535.     n = check_declared(name);
  536.     if (n != -1 && (VARIABLE(n)->type & TYPE_MOD_NO_MASK)) {
  537.     char *p = (char *)alloca(80 + strlen(name));
  538.     sprintf(p, "Illegal to redefine 'nomask' variable \"%s\"", name);
  539.     yyerror(p);
  540.     }
  541.     dummy.name = make_shared_string(name);
  542.     dummy.type = type;
  543.     dummy.flags = flags;
  544.     add_to_mem_block(A_VARIABLES, (char *)&dummy, sizeof dummy);
  545. }
  546.  
  547. short store_prog_string(str)
  548.     char *str;
  549. {
  550.     short i;
  551.     char **p;
  552.  
  553.     p = (char **) mem_block[A_STRINGS].block;
  554.     str = make_shared_string(str);
  555.     for (i=mem_block[A_STRINGS].current_size / sizeof str -1; i>=0; --i)
  556.     if (p[i] == str)  {
  557.         free_string(str); /* Needed as string is only free'ed once. */
  558.         return i;
  559.     }
  560.  
  561.     add_to_mem_block(A_STRINGS, &str, sizeof str);
  562.     return mem_block[A_STRINGS].current_size / sizeof str - 1;
  563. }
  564.  
  565. void add_to_case_heap(block_index,entry)
  566.     int block_index;
  567.     struct case_heap_entry *entry;
  568. {
  569.     char *heap_start;
  570.     int offset,parent;
  571.     int current_heap;
  572.  
  573.     if ( block_index == A_CASE_NUMBERS )
  574.         current_heap = current_case_number_heap;
  575.     else
  576.         current_heap = current_case_string_heap;
  577.     offset = mem_block[block_index].current_size - current_heap;
  578.     add_to_mem_block(block_index, (char*)entry, sizeof(*entry) );
  579.     heap_start = mem_block[block_index].block + current_heap;
  580.     for ( ; offset; offset = parent ) {
  581.         parent = ( offset - sizeof(struct case_heap_entry) ) >> 1 ;
  582.         CASE_HEAP_ENTRY_ALIGN(parent);
  583.         if ( ((struct case_heap_entry*)(heap_start+offset))->key <
  584.              ((struct case_heap_entry*)(heap_start+parent))->key )
  585.         {
  586.             *(struct case_heap_entry*)(heap_start+offset) =
  587.             *(struct case_heap_entry*)(heap_start+parent);
  588.             *(struct case_heap_entry*)(heap_start+parent) = *entry;
  589.         }
  590.     }
  591. }
  592.  
  593. /*
  594.  * Arrange a jump to the current position for the initialization code
  595.  * to continue.
  596.  */
  597. static void transfer_init_control() {
  598.     if (mem_block[A_PROGRAM].current_size - 2 == last_initializer_end)
  599.     mem_block[A_PROGRAM].current_size -= 3;
  600.     else {
  601.     /*
  602.      * Change the address of the last jump after the last
  603.      * initializer to this point.
  604.      */
  605.     upd_short(last_initializer_end,
  606.           mem_block[A_PROGRAM].current_size);
  607.     }
  608. }
  609.  
  610. void add_new_init_jump();
  611. %}
  612.  
  613. /*
  614.  * These values are used by the stack machine, and can not be directly
  615.  * called from LPC.
  616.  */
  617. %token F_JUMP F_JUMP_WHEN_ZERO F_JUMP_WHEN_NON_ZERO
  618. %token F_POP_VALUE F_DUP
  619. %token F_STORE F_CALL_FUNCTION_BY_ADDRESS
  620. %token F_PUSH_IDENTIFIER_LVALUE F_PUSH_LOCAL_VARIABLE_LVALUE
  621. %token F_PUSH_INDEXED_LVALUE F_INDIRECT F_INDEX
  622. %token F_CONST0 F_CONST1
  623.  
  624. /*
  625.  * These are the predefined functions that can be accessed from LPC.
  626.  */
  627.  
  628. %token F_IF F_IDENTIFIER F_LAND F_LOR F_STATUS
  629. %token F_RETURN F_STRING
  630. %token F_INC F_DEC
  631. %token F_POST_INC F_POST_DEC F_COMMA
  632. %token F_NUMBER F_ASSIGN F_INT F_ADD F_SUBTRACT F_MULTIPLY
  633. %token F_DIVIDE F_LT F_GT F_EQ F_GE F_LE
  634. %token F_NE
  635. %token F_ADD_EQ F_SUB_EQ F_DIV_EQ F_MULT_EQ
  636. %token F_NEGATE
  637. %token F_SUBSCRIPT F_WHILE F_BREAK
  638. %token F_DO F_FOR F_SWITCH
  639. %token F_SSCANF F_PARSE_COMMAND F_STRING_DECL F_LOCAL_NAME
  640. %token F_ELSE F_DESCRIBE
  641. %token F_CONTINUE
  642. %token F_MOD F_MOD_EQ F_INHERIT F_COLON_COLON
  643. %token F_STATIC
  644. %token F_ARROW F_AGGREGATE
  645. %token F_COMPL F_AND F_AND_EQ F_OR F_OR_EQ F_XOR F_XOR_EQ
  646. %token F_LSH F_LSH_EQ F_RSH F_RSH_EQ
  647. %token F_CATCH
  648. %token F_OBJECT F_VOID F_MIXED F_PRIVATE F_NO_MASK F_NOT
  649. %token F_PROTECTED F_PUBLIC
  650. %token F_VARARGS
  651. %token F_ADD_ACTION
  652. %token F_ADD_VERB
  653. %token F_ADD_WORTH
  654. %token F_ADD_XVERB
  655. %token F_ALL_INVENTORY
  656. %token F_ALLOCATE
  657. %token F_ASSOC
  658. %token F_BREAK_POINT
  659. %token F_CALL_OTHER
  660. %token F_CALL_OUT
  661. %token F_CALL_OUT_INFO
  662. %token F_CAPITALIZE
  663. %token F_CAT
  664. %token F_CINDENT
  665. %token F_CLEAR_BIT
  666. %token F_CLONE_OBJECT
  667. %token F_COMMAND
  668. %token F_CRYPT
  669. %token F_CTIME
  670. %token F_DEBUG_INFO
  671. %token F_DEEP_INVENTORY
  672. %token F_DESTRUCT
  673. %token F_DISABLE_COMMANDS
  674. %token F_ED
  675. %token F_ENABLE_COMMANDS
  676. %token F_ENVIRONMENT
  677. %token F_EXEC
  678. %token F_EXPLODE
  679. %token F_EXPORT_UID
  680. %token F_EXTRACT
  681. %token F_FILE_NAME
  682. %token F_FILE_SIZE
  683. %token F_FILTER_ARRAY
  684. %token F_FIND_CALL_OUT
  685. %token F_FIND_LIVING
  686. %token F_FIND_OBJECT
  687. %token F_FIND_PLAYER
  688. %token F_FIRST_INVENTORY
  689. %token F_FUNCTION_EXISTS
  690. %token F_GET_DIR
  691. %token F_GETEUID
  692. %token F_GETUID
  693. %token F_IMPLODE
  694. %token F_INHERIT_LIST
  695. %token F_INPUT_TO
  696. %token F_INSERT_ALIST
  697. %token F_INTERACTIVE
  698. %token F_INTERSECT_ALIST
  699. %token F_INTP
  700. %token F_LIVING
  701. %token F_LOCALCMD
  702. %token F_LOG_FILE
  703. %token F_LOWER_CASE
  704. %token F_MAP_ARRAY
  705. %token F_MEMBER_ARRAY
  706. %token F_MKDIR
  707. %token F_MOVE_OBJECT
  708. %token F_NEXT_INVENTORY
  709. %token F_NOTIFY_FAIL
  710. %token F_OBJECTP
  711. %token F_ORDER_ALIST
  712. %token F_POINTERP
  713. %token F_PRESENT
  714. %token F_PREVIOUS_OBJECT
  715. %token F_PROCESS_STRING
  716. %token F_QUERY_HOST_NAME
  717. %token F_QUERY_IDLE
  718. %token F_QUERY_IP_NAME
  719. %token F_QUERY_IP_NUMBER
  720. %token F_QUERY_LOAD_AVERAGE
  721. %token F_QUERY_SNOOP
  722. %token F_QUERY_VERB
  723. %token F_RANDOM
  724. %token F_READ_BYTES
  725. %token F_READ_FILE
  726. %token F_REGEXP
  727. %token F_REMOVE_CALL_OUT
  728. %token F_RENAME
  729. %token F_RESTORE_OBJECT
  730. %token F_RM
  731. %token F_RMDIR
  732. %token F_SAVE_OBJECT
  733. %token F_SAY
  734. %token F_SET_BIT
  735. %token F_SET_HEART_BEAT
  736. %token F_SET_LIGHT
  737. %token F_SET_LIVING_NAME
  738. %token F_SETEUID
  739. %token F_SHADOW
  740. %token F_SHOUT
  741. %token F_SHUTDOWN
  742. %token F_SIZEOF
  743. %token F_SNOOP
  744. %token F_SORT_ARRAY
  745. %token F_STRINGP
  746. %token F_STRLEN
  747. %token F_SWAP
  748. %token F_TAIL
  749. %token F_TELL_OBJECT
  750. %token F_TELL_ROOM
  751. %token F_TEST_BIT
  752. %token F_THIS_OBJECT
  753. %token F_THIS_PLAYER
  754. %token F_THROW
  755. %token F_TIME
  756. %token F_TRACE
  757. %token F_TRACEPREFIX
  758. %token F_UNIQUE_ARRAY
  759. %token F_USERS
  760. %token F_VERSION
  761. %token F_WIZLIST
  762. %token F_WRITE
  763. %token F_WRITE_BYTES
  764. %token F_WRITE_FILE
  765. /*
  766.  * These are token values that needn't have an associated code for the
  767.  * compiled file
  768.  */
  769.  
  770. %token F_CASE F_DEFAULT F_RANGE
  771.  
  772. %union
  773. {
  774.     int number;
  775.     unsigned int address;    /* Address of an instruction */
  776.     char *string;
  777.     short type;
  778.     struct { int key; char block; } case_label;
  779.     struct function *funp;
  780. }
  781.  
  782. %type <number> assign F_NUMBER constant F_LOCAL_NAME expr_list
  783. %type <number> const1 const2 const3 const4 const5 const6 const7 const8 const9
  784. %type <number> lvalue_list argument type basic_type optional_star expr_list2
  785. %type <number> type_modifier type_modifier_list opt_basic_type block_or_semi
  786. %type <number> argument_list
  787. %type <string> F_IDENTIFIER F_STRING string_con1 string_constant function_name
  788.  
  789. %type <case_label> case_label
  790.  
  791. /* The following symbos return type information */
  792.  
  793. %type <type> function_call lvalue string cast expr28 expr01 comma_expr
  794. %type <type> expr2 expr211 expr1 expr212 expr213 expr24 expr22 expr23 expr25
  795. %type <type> expr27 expr28 expr24 expr3 expr31 expr4 number expr0
  796. %%
  797.  
  798. all: program;
  799.  
  800. program: program def possible_semi_colon
  801.        |     /* empty */ ;
  802.  
  803. possible_semi_colon: /* empty */
  804.                    | ';' { yyerror("Extra ';'. Ignored."); };
  805.  
  806. inheritance: type_modifier_list F_INHERIT F_STRING ';'
  807.         {
  808.             struct object *ob;
  809.             struct inherit inherit;
  810.             int initializer;
  811.  
  812.             ob = find_object2($3);
  813.             if (ob == 0) {
  814.             inherit_file = $3;
  815.             /* Return back to load_object() */
  816.             YYACCEPT;
  817.             }
  818.             free($3);
  819.             if (ob->flags & O_APPROVED)
  820.             approved_object = 1;
  821.             inherit.prog = ob->prog;
  822.             inherit.function_index_offset =
  823.             mem_block[A_FUNCTIONS].current_size /
  824.                 sizeof (struct function);
  825.             inherit.variable_index_offset =
  826.             mem_block[A_VARIABLES].current_size /
  827.                 sizeof (struct variable);
  828.             add_to_mem_block(A_INHERITS, &inherit, sizeof inherit);
  829.             copy_variables(ob->prog, $1);
  830.             initializer = copy_functions(ob->prog, $1);
  831.             if (initializer > 0) {
  832.             struct function *funp;
  833.             int f;
  834.             f = define_new_function("::__INIT", 0, 0, 0, 0, 0);
  835.             funp = FUNCTION(f);
  836.             funp->offset = mem_block[A_INHERITS].current_size /
  837.                 sizeof (struct inherit) - 1;
  838.             funp->flags = NAME_STRICT_TYPES |
  839.                 NAME_INHERITED | NAME_HIDDEN;
  840.             funp->type = TYPE_VOID;
  841.             funp->function_index_offset = initializer;
  842.             transfer_init_control();
  843.             ins_f_byte(F_CALL_FUNCTION_BY_ADDRESS);
  844.             ins_short(f);
  845.             ins_byte(0);    /* Actual number of arguments */
  846.             ins_f_byte(F_POP_VALUE);
  847.             add_new_init_jump();
  848.             }
  849.         }
  850.  
  851. number: F_NUMBER
  852.     {
  853.         if ( $1 == 0 ) {
  854.         ins_f_byte(F_CONST0); $$ = TYPE_ANY;
  855.         } else if ( $1 == 1 ) {
  856.         ins_f_byte(F_CONST1); $$ = TYPE_NUMBER;
  857.         } else {
  858.         ins_f_byte(F_NUMBER); ins_long($1); $$ = TYPE_NUMBER;
  859.         }
  860.     } ;
  861.  
  862. optional_star: /* empty */ { $$ = 0; } | '*' { $$ = TYPE_MOD_POINTER; } ;
  863.  
  864. block_or_semi: block { $$ = 0; } | ';' { $$ = ';'; } ;
  865.  
  866. def: type optional_star F_IDENTIFIER
  867.     {
  868.         /* Save start of function. */
  869.         push_explicit(mem_block[A_PROGRAM].current_size);
  870.  
  871.         if ($1 & TYPE_MOD_MASK) {
  872.         exact_types = $1 | $2;
  873.         } else {
  874.         if (pragma_strict_types)
  875.             yyerror("\"#pragma strict_types\" requires type of function");
  876.         exact_types = 0;
  877.         }
  878.     }
  879.     '(' argument ')'
  880.     {
  881.         /*
  882.          * Define a prototype. If it is a real function, then the
  883.          * prototype will be replaced below.
  884.          */
  885.         define_new_function($3, $6, 0, 0,
  886.                 NAME_UNDEFINED|NAME_PROTOTYPE, $1 | $2);
  887.     }
  888.         block_or_semi
  889.     {
  890.         /* Either a prototype or a block */
  891.         if ($9 == ';') {
  892.         (void)pop_address(); /* Not used here */
  893.         } else {
  894.         define_new_function($3, $6, current_number_of_locals - $6+
  895.             ( max_break_stack_need -1 ) / sizeof(struct svalue) +1,
  896.             pop_address(), 0, $1 | $2);
  897.         ins_f_byte(F_CONST0); ins_f_byte(F_RETURN);
  898.         }
  899.         free_all_local_names();
  900.         free($3);        /* Value was copied above */
  901.     }
  902.    | type name_list ';' { if ($1 == 0) yyerror("Missing type"); }
  903.    | inheritance ;
  904.  
  905. new_arg_name: type optional_star F_IDENTIFIER
  906.     {
  907.         if (exact_types && $1 == 0) {
  908.         yyerror("Missing type for argument");
  909.         add_local_name($3, TYPE_ANY);    /* Supress more errors */
  910.         } else {
  911.         add_local_name($3, $1 | $2);
  912.         }
  913.     }
  914.       | type F_LOCAL_NAME
  915.         {yyerror("Illegal to redeclare local name"); } ;
  916.  
  917. argument: /* empty */ { $$ = 0; }
  918.       | argument_list ;
  919.  
  920. argument_list: new_arg_name { $$ = 1; }
  921.          | argument_list ',' new_arg_name { $$ = $1 + 1; } ;
  922.  
  923. type_modifier: F_NO_MASK { $$ = TYPE_MOD_NO_MASK; }
  924.          | F_STATIC { $$ = TYPE_MOD_STATIC; }
  925.          | F_PRIVATE { $$ = TYPE_MOD_PRIVATE; }
  926.          | F_PUBLIC { $$ = TYPE_MOD_PUBLIC; }
  927.          | F_VARARGS { $$ = TYPE_MOD_VARARGS; }
  928.          | F_PROTECTED { $$ = TYPE_MOD_PROTECTED; } ;
  929.  
  930. type_modifier_list: /* empty */ { $$ = 0; }
  931.           | type_modifier type_modifier_list { $$ = $1 | $2; } ;
  932.  
  933. type: type_modifier_list opt_basic_type { $$ = $1 | $2; current_type = $$; } ;
  934.  
  935. cast: '(' basic_type optional_star ')'
  936.     {
  937.         $$ = $2 | $3;
  938.     } ;
  939.  
  940. opt_basic_type: basic_type | /* empty */ { $$ = TYPE_UNKNOWN; } ;
  941.  
  942. basic_type: F_STATUS { $$ = TYPE_NUMBER; current_type = $$; }
  943.     | F_INT { $$ = TYPE_NUMBER; current_type = $$; }
  944.     | F_STRING_DECL { $$ = TYPE_STRING; current_type = $$; }
  945.     | F_OBJECT { $$ = TYPE_OBJECT; current_type = $$; }
  946.     | F_VOID {$$ = TYPE_VOID; current_type = $$; }
  947.     | F_MIXED { $$ = TYPE_ANY; current_type = $$; } ;
  948.  
  949. name_list: new_name
  950.      | new_name ',' name_list;
  951.  
  952. new_name: optional_star F_IDENTIFIER
  953.     {
  954.         define_variable($2, current_type | $1, 0);
  955.         free($2);
  956.     }
  957. | optional_star F_IDENTIFIER
  958.     {
  959.         int var_num;
  960.         define_variable($2, current_type | $1, 0);
  961.         var_num = verify_declared($2);
  962.         transfer_init_control();
  963.         ins_f_byte(F_PUSH_IDENTIFIER_LVALUE);
  964.         ins_byte(var_num);
  965.     }
  966.     '=' expr0
  967.     {
  968.         if (!compatible_types((current_type | $1) & TYPE_MOD_MASK, $5)){
  969.         char buff[100];
  970.         sprintf(buff, "Type mismatch %s when initializing %s",
  971.             get_two_types(current_type | $1, $5), $2);
  972.         yyerror(buff);
  973.         }
  974.         ins_f_byte(F_ASSIGN);
  975.         ins_f_byte(F_POP_VALUE);
  976.         add_new_init_jump();
  977.         free($2);
  978.     } ;
  979. block: '{' local_declarations statements '}'
  980.     { ; };
  981.  
  982. local_declarations: /* empty */
  983.           | local_declarations basic_type local_name_list ';' ;
  984.  
  985. new_local_name: optional_star F_IDENTIFIER
  986.     {
  987.         add_local_name($2, current_type | $1);
  988.     } ;
  989.  
  990. local_name_list: new_local_name
  991.     | new_local_name ',' local_name_list ;
  992.  
  993. statements: /* empty */
  994.       | statement statements
  995.       | error ';' ;
  996.  
  997. statement: comma_expr ';'
  998.     {
  999.         ins_f_byte(F_POP_VALUE);
  1000.         if (d_flag)
  1001.         ins_f_byte(F_BREAK_POINT);
  1002.         /* if (exact_types && !TYPE($1,TYPE_VOID))
  1003.         yyerror("Value thrown away"); */
  1004.     }
  1005.      | cond | while | do | for | switch | case | default | return ';'
  1006.      | block
  1007.        | /* empty */ ';'
  1008.      | F_BREAK ';'    /* This code is a jump to a jump */
  1009.         {
  1010.             if (current_break_address == 0)
  1011.             yyerror("break statement outside loop");
  1012.             if (current_break_address & BREAK_ON_STACK) {
  1013.             ins_f_byte(F_BREAK);
  1014.             } else {
  1015.                 ins_f_byte(F_JUMP); ins_short(current_break_address);
  1016.             }
  1017.         }
  1018.      | F_CONTINUE ';'    /* This code is a jump to a jump */
  1019.         {
  1020.             if (current_continue_address == 0)
  1021.             yyerror("continue statement outside loop");
  1022.             ins_f_byte(F_JUMP); ins_short(current_continue_address);
  1023.         }
  1024.          ;
  1025.  
  1026. while:  {   push_explicit(current_continue_address);
  1027.         push_explicit(current_break_address);
  1028.         current_continue_address = mem_block[A_PROGRAM].current_size;
  1029.     } F_WHILE '(' comma_expr ')'
  1030.     {
  1031.         ins_f_byte(F_JUMP_WHEN_NON_ZERO); ins_short(0);    /* to block */
  1032.         current_break_address = mem_block[A_PROGRAM].current_size;
  1033.         ins_f_byte(F_JUMP); ins_short(0);    /* Exit loop */
  1034.         upd_short(current_break_address-2,
  1035.               mem_block[A_PROGRAM].current_size);
  1036.     }
  1037.        statement
  1038.     {
  1039.       ins_f_byte(F_JUMP); ins_short(current_continue_address);
  1040.       upd_short(current_break_address+1,
  1041.             mem_block[A_PROGRAM].current_size);
  1042.       current_break_address = pop_address();
  1043.       current_continue_address = pop_address();
  1044.         }
  1045.  
  1046. do: {
  1047.         int tmp_save;
  1048.         push_explicit(current_continue_address);
  1049.     push_explicit(current_break_address);
  1050.     /* Jump to start of loop. */
  1051.     ins_f_byte(F_JUMP); tmp_save = mem_block[A_PROGRAM].current_size;
  1052.     ins_short(0);
  1053.     current_break_address = mem_block[A_PROGRAM].current_size;
  1054.     /* Jump to end of loop. All breaks go through this one. */
  1055.     ins_f_byte(F_JUMP); push_address(); ins_short(0);
  1056.     current_continue_address = mem_block[A_PROGRAM].current_size;
  1057.     upd_short(tmp_save, current_continue_address);
  1058.         push_address();
  1059.     
  1060.     } F_DO statement F_WHILE '(' comma_expr ')' ';'
  1061.     {
  1062.     ins_f_byte(F_JUMP_WHEN_NON_ZERO); ins_short(pop_address());
  1063.     /* Fill in the break jump address in the beginning of the loop. */
  1064.     upd_short(pop_address(), mem_block[A_PROGRAM].current_size);
  1065.     current_break_address = pop_address();
  1066.     current_continue_address = pop_address();
  1067.     }
  1068.  
  1069. for: F_FOR '('      { push_explicit(current_continue_address);
  1070.             push_explicit(current_break_address); }
  1071.      for_expr ';' {   ins_f_byte(F_POP_VALUE);
  1072.               push_address();
  1073.           }
  1074.      for_expr ';' {
  1075.             ins_f_byte(F_JUMP_WHEN_NON_ZERO);
  1076.             ins_short(0);    /* Jump to block of block */
  1077.             current_break_address = mem_block[A_PROGRAM].current_size;
  1078.             ins_f_byte(F_JUMP); ins_short(0);    /* Out of loop */
  1079.              current_continue_address =
  1080.             mem_block[A_PROGRAM].current_size;
  1081.           }
  1082.      for_expr ')' {
  1083.              ins_f_byte(F_POP_VALUE);
  1084.             ins_f_byte(F_JUMP); ins_short(pop_address());
  1085.             /* Here starts the block. */
  1086.             upd_short(current_break_address-2,
  1087.                   mem_block[A_PROGRAM].current_size);
  1088.           }
  1089.      statement
  1090.    {
  1091.        ins_f_byte(F_JUMP); ins_short(current_continue_address);
  1092.        /* Now, the address of the end of the block is known. */
  1093.        upd_short(current_break_address+1, mem_block[A_PROGRAM].current_size);
  1094.        current_break_address = pop_address();
  1095.        current_continue_address = pop_address();
  1096.    }
  1097.  
  1098. for_expr: /* EMPTY */ { ins_f_byte(F_CONST1); }
  1099.         | comma_expr;
  1100.  
  1101. switch: F_SWITCH '(' comma_expr ')'
  1102.     {
  1103.         current_break_stack_need += sizeof(short);
  1104.         if ( current_break_stack_need > max_break_stack_need )
  1105.             max_break_stack_need = current_break_stack_need;
  1106.     push_explicit(current_case_number_heap);
  1107.     push_explicit(current_case_string_heap);
  1108.     push_explicit(zero_case_label);
  1109.     push_explicit(current_break_address);
  1110.     ins_f_byte(F_SWITCH);
  1111.     ins_byte(0xff); /* kind of table */
  1112.     current_case_number_heap = mem_block[A_CASE_NUMBERS].current_size;
  1113.     current_case_string_heap = mem_block[A_CASE_STRINGS].current_size;
  1114.     zero_case_label = NO_STRING_CASE_LABELS;
  1115.     ins_short(0); /* address of table */
  1116.     current_break_address = mem_block[A_PROGRAM].current_size |
  1117.                 BREAK_ON_STACK | BREAK_FROM_CASE ;
  1118.     ins_short(0); /* break address to push, table is entered before */
  1119.     ins_short(0); /* default address */
  1120.     }
  1121.       statement
  1122.     {
  1123.     char *heap_start;
  1124.     int heap_end_offs;
  1125.     int i,o;
  1126.     int current_key,last_key;
  1127.     /* int size_without_table; */
  1128.     int block_index;
  1129.     int current_case_heap;
  1130.     int lookup_start;
  1131.     int lookup_start_key;
  1132.  
  1133.     current_break_address &= ~(BREAK_ON_STACK|BREAK_FROM_CASE);
  1134.  
  1135.     if ( !read_short(current_break_address+2 ) )
  1136.         upd_short(current_break_address+2,     /* no default given ->  */
  1137.           mem_block[A_PROGRAM].current_size);  /* create one           */
  1138.  
  1139.     /* it isn't unusual that the last case/default has no break */
  1140.     ins_f_byte(F_BREAK);
  1141.     if(zero_case_label & (NO_STRING_CASE_LABELS|SOME_NUMERIC_CASE_LABELS)){
  1142.         block_index = A_CASE_NUMBERS;
  1143.         current_case_heap = current_case_number_heap;
  1144.     } else {
  1145.         block_index = A_CASE_STRINGS;
  1146.         current_case_heap = current_case_string_heap;
  1147.         if (zero_case_label&0xffff) {
  1148.         struct case_heap_entry temp;
  1149.  
  1150.         temp.key = ZERO_AS_STR_CASE_LABEL;
  1151.         temp.addr = zero_case_label;
  1152.         temp.line = 0; /* if this is accessed later, something is
  1153.                 * really wrong                  */
  1154.         add_to_case_heap(A_CASE_STRINGS,&temp);
  1155.         }
  1156.     }
  1157.     heap_start = mem_block[block_index].block + current_case_heap ;
  1158.     heap_end_offs = mem_block[block_index].current_size -current_case_heap;
  1159.     if (!heap_end_offs) yyerror("switch without case not supported");
  1160.  
  1161.         /* add a dummy entry so that we can always
  1162.         * assume we have no or two childs
  1163.         */
  1164.         add_to_mem_block(block_index, "\0\0\0\0\0\0\0\0",
  1165.             sizeof(struct case_heap_entry) );
  1166.  
  1167.         /* read out the heap and build a sorted table */
  1168.     /* the table could be optimized better, but let's first see
  1169.     * how much switch is used at all when it is full-featured...
  1170.     */
  1171.     mem_block[A_CASE_LABELS].current_size = 0;
  1172.     lookup_start = 0;
  1173.     lookup_start_key = ((struct case_heap_entry*)heap_start)->key;
  1174.         for( ; ((struct case_heap_entry*)heap_start)->addr; )
  1175.         {
  1176.             int offset;
  1177.         int curr_line,last_line;
  1178.         unsigned short current_addr,last_addr = 0xffff;
  1179.         int range_start;
  1180.  
  1181.             current_key = ((struct case_heap_entry*)heap_start)->key ;
  1182.             curr_line = ((struct case_heap_entry*)heap_start)->line ;
  1183.             current_addr = ((struct case_heap_entry*)heap_start)->addr ;
  1184.             if ( current_key == last_key &&
  1185.               mem_block[A_CASE_LABELS].current_size )
  1186.             {
  1187.                 char buf[90];
  1188.  
  1189.                 sprintf(buf,"Duplicate case in line %d and %d",
  1190.             last_line, curr_line);
  1191.                 yyerror(buf);
  1192.             }
  1193.         if (curr_line) {
  1194.         if (last_addr == 1) {
  1195.                     char buf[120];
  1196.     
  1197.             sprintf(buf,
  1198. "Discontinued case label list range, line %d by line %d",
  1199.               last_line, curr_line);
  1200.                     yyerror(buf);
  1201.         }
  1202.           else if (current_key == last_key + 1
  1203.             && current_addr == last_addr) {
  1204.             if (mem_block[A_CASE_LABELS].current_size
  1205.               != range_start + 6) {
  1206.               *(short*)(mem_block[A_CASE_LABELS].block+range_start+4)
  1207.             =1;
  1208.               mem_block[A_CASE_LABELS].current_size = range_start + 6;
  1209.             }
  1210.         } else {
  1211.             range_start = mem_block[A_CASE_LABELS].current_size;
  1212.         }
  1213.         }
  1214.             last_key = current_key;
  1215.         last_line = curr_line;
  1216.         last_addr = current_addr;
  1217.         add_to_mem_block(A_CASE_LABELS,
  1218.                 (char *)¤t_key, sizeof(long) );
  1219.         add_to_mem_block(A_CASE_LABELS,
  1220.         (char *)¤t_addr, sizeof(short) );
  1221.             for ( offset = 0; ; )
  1222.             {
  1223.  
  1224.                 int child1,child2;
  1225.  
  1226.                 child1 = ( offset << 1 ) + sizeof(struct case_heap_entry);
  1227.                 child2 = child1 + sizeof(struct case_heap_entry);
  1228.                 if ( child1 >= heap_end_offs ) break;
  1229.                 if ( ((struct case_heap_entry*)(heap_start+child1))->addr &&
  1230.                   ( !((struct case_heap_entry*)(heap_start+child2))->addr ||
  1231.                    ((struct case_heap_entry*)(heap_start+child1))->key <=
  1232.                    ((struct case_heap_entry*)(heap_start+child2))->key  ) )
  1233.                 {
  1234.                     *(struct case_heap_entry*)(heap_start+offset) =
  1235.                     *(struct case_heap_entry*)(heap_start+child1);
  1236.                     offset = child1;
  1237.                 } else
  1238.                     if (((struct case_heap_entry*)(heap_start+child2))->addr ) {
  1239.                         *(struct case_heap_entry*)(heap_start+offset) =
  1240.                         *(struct case_heap_entry*)(heap_start+child2);
  1241.                         offset = child2;
  1242.                     } else break;
  1243.             }
  1244.             ((struct case_heap_entry*)(heap_start+offset))->addr = 0;
  1245.         }
  1246.  
  1247.     /* write start of table */
  1248.         upd_short(current_break_address-2,
  1249.             mem_block[A_PROGRAM].current_size);
  1250.  
  1251.     add_to_mem_block(A_PROGRAM, mem_block[A_CASE_LABELS].block,
  1252.             mem_block[A_CASE_LABELS].current_size );
  1253.         /* calculate starting index for itarative search at execution time */
  1254.         for(i=0xf0,o=6; o<<1 <= mem_block[A_CASE_LABELS].current_size; )
  1255.             i++,o<<=1;
  1256.         if (block_index == A_CASE_STRINGS) i = ( i << 4 ) | 0xf;
  1257.         /* and store it */
  1258.         mem_block[A_PROGRAM].block[current_break_address-3] &= i;
  1259. #if 0  /* neither the code for ordinary switch is fully debugged now,
  1260.     * nor is the code for packed switch tables complete */
  1261.     d = ((struct case_heap_entry*)heap_start)->key;
  1262.     if ( (r-d)*sizeof(short) < heap_end_offs ) {
  1263.         mem_block[A_PROGRAM].block[current_break_address-3] &= 0xfe;
  1264.             upd_short(current_break_address-2, mem_block[A_PROGRAM].current_size);
  1265.             size_without_table = mem_block[A_PROGRAM].current_size;
  1266.         r = heap_end_offs / sizeof(struct case_heap_entry);
  1267.         add_to_mem_block(A_PROGRAM,mem_block[A_PROGRAM]->block,
  1268.         r * sizeof(short) );
  1269.         memset(mem_block[A_PROGRAM]->block+size_without_table,
  1270.         '\0',r * sizeof(short) );
  1271.         ins_long( d );
  1272.         for(; --r; heap_start += sizeof(struct case_heap_entry) )
  1273.         {
  1274.         upd_short(size_without_table + sizeof(short)*
  1275.                     ( ((struct case_heap_entry*)heap_start)->key - d )
  1276.           , ((struct case_heap_entry*)heap_start)->addr );
  1277.         }
  1278.         }
  1279. #endif /* 0 */
  1280.     upd_short(current_break_address, mem_block[A_PROGRAM].current_size);
  1281.     
  1282.     mem_block[A_CASE_NUMBERS].current_size = current_case_number_heap;
  1283.     mem_block[A_CASE_STRINGS].current_size = current_case_string_heap;
  1284.         current_break_address = pop_address();
  1285.     zero_case_label = pop_address();
  1286.         current_case_string_heap = pop_address();
  1287.         current_case_number_heap = pop_address();
  1288.         current_break_stack_need -= sizeof(short);
  1289.     } ;
  1290.  
  1291. case: F_CASE case_label ':'
  1292.     {
  1293.     struct case_heap_entry temp;
  1294.  
  1295.     if ( !( current_break_address & BREAK_FROM_CASE ) ) {
  1296.         yyerror("Case outside switch");
  1297.         break;
  1298.     }
  1299.     temp.key = $2.key;
  1300.     temp.addr = mem_block[A_PROGRAM].current_size;
  1301.     temp.line = current_line;
  1302.     add_to_case_heap($2.block,&temp);
  1303.     }
  1304.     | F_CASE case_label F_RANGE case_label ':'
  1305.     {
  1306.     struct case_heap_entry temp;
  1307.  
  1308.     if ( $2.block != A_CASE_NUMBERS || $4.block != A_CASE_NUMBERS )
  1309.         yyerror("String case labels not allowed as range bounds");
  1310.     if ($2.key > $4.key) break;
  1311.     temp.key = $2.key;
  1312.     temp.addr = 1;
  1313.     temp.line = current_line;
  1314.     add_to_case_heap(A_CASE_NUMBERS,&temp);
  1315.     temp.key = $4.key;
  1316.     temp.addr = mem_block[A_PROGRAM].current_size;
  1317.     temp.line = 0;
  1318.     add_to_case_heap(A_CASE_NUMBERS,&temp);
  1319.     } ;
  1320.     
  1321. case_label: constant
  1322.         {
  1323.         if ( !(zero_case_label & NO_STRING_CASE_LABELS) )
  1324.         yyerror("Mixed case label list not allowed");
  1325.         if ( $$.key = $1 )
  1326.             zero_case_label |= SOME_NUMERIC_CASE_LABELS;
  1327.         else
  1328.         zero_case_label |= mem_block[A_PROGRAM].current_size;
  1329.         $$.block = A_CASE_NUMBERS;
  1330.     }
  1331.       | string_constant
  1332.         {
  1333.         if ( zero_case_label & SOME_NUMERIC_CASE_LABELS )
  1334.         yyerror("Mixed case label list not allowed");
  1335.         zero_case_label &= ~NO_STRING_CASE_LABELS;
  1336.             store_prog_string($1);
  1337.             $$.key = (int)$1;
  1338.         $$.block = A_CASE_STRINGS;
  1339.         }
  1340.       ;
  1341.  
  1342. constant: const1
  1343.     | constant '|' const1 { $$ = $1 | $3; } ;
  1344.  
  1345. const1: const2
  1346.       | const1 '^' const2 { $$ = $1 ^ $3; } ;
  1347.  
  1348. const2: const3
  1349.       | const2 '&' const3 { $$ = $1 & $3; } ;
  1350.  
  1351. const3: const4
  1352.       | const3 F_EQ const4 { $$ = $1 == $3; }
  1353.       | const3 F_NE const4 { $$ = $1 != $3; } ;
  1354.  
  1355. const4: const5
  1356.       | const4 '>'  const5 { $$ = $1 >  $3; }
  1357.       | const4 F_GE const5 { $$ = $1 >= $3; }
  1358.       | const4 '<'  const5 { $$ = $1 <  $3; }
  1359.       | const4 F_LE const5 { $$ = $1 <= $3; } ;
  1360.  
  1361. const5: const6
  1362.       | const5 F_LSH const6 { $$ = $1 << $3; }
  1363.       | const5 F_RSH const6 { $$ = $1 >> $3; } ;
  1364.  
  1365. const6: const7
  1366.       | const6 '+' const7 { $$ = $1 + $3; }
  1367.       | const6 '-' const7 { $$ = $1 - $3; } ;
  1368.  
  1369. const7: const8
  1370.       | const7 '*' const8 { $$ = $1 * $3; }
  1371.       | const7 '%' const8 { $$ = $1 % $3; }
  1372.       | const7 '/' const8 { $$ = $1 / $3; } ;
  1373.  
  1374. const8: const9
  1375.       | '(' constant ')' { $$ = $2; } ;
  1376.  
  1377. const9: F_NUMBER
  1378.       | '-'   F_NUMBER { $$ = -$2; }
  1379.       | F_NOT F_NUMBER { $$ = !$2; }
  1380.       | '~'   F_NUMBER { $$ = ~$2; } ;
  1381.  
  1382. default: F_DEFAULT ':'
  1383.     {
  1384.     if ( !( current_break_address & BREAK_FROM_CASE ) ) {
  1385.         yyerror("Default outside switch");
  1386.         break;
  1387.     }
  1388.     current_break_address &= ~(BREAK_ON_STACK|BREAK_FROM_CASE);
  1389.     if ( read_short(current_break_address+2 ) )
  1390.         yyerror("Duplicate default");
  1391.     upd_short(current_break_address+2, mem_block[A_PROGRAM].current_size);
  1392.     current_break_address |= (BREAK_ON_STACK|BREAK_FROM_CASE);
  1393.     } ;
  1394.  
  1395.  
  1396. comma_expr: expr0 { $$ = $1; }
  1397.           | comma_expr { ins_f_byte(F_POP_VALUE); }
  1398.     ',' expr0
  1399.     { $$ = $4; } ;
  1400.  
  1401. expr0:  expr01
  1402.      | lvalue assign expr0
  1403.     {
  1404.         if (exact_types && !compatible_types($1, $3) &&
  1405.         !($1 == TYPE_STRING && $3 == TYPE_NUMBER && $2 == F_ADD_EQ))
  1406.         {
  1407.         type_error("Bad assignment. Rhs", $3);
  1408.         }
  1409.         ins_f_byte($2);
  1410.         $$ = $3;
  1411.     }
  1412.      | error assign expr01 { yyerror("Illegal LHS");  $$ = TYPE_ANY; };
  1413.  
  1414. expr01: expr1 { $$ = $1; }
  1415.      | expr1 '?'
  1416.     {
  1417.         ins_f_byte(F_JUMP_WHEN_ZERO);
  1418.         push_address();
  1419.         ins_short(0);
  1420.     }
  1421.       expr01
  1422.     {
  1423.         int i;
  1424.         i = pop_address();
  1425.         ins_f_byte(F_JUMP); push_address(); ins_short(0);
  1426.         upd_short(i, mem_block[A_PROGRAM].current_size);
  1427.     }
  1428.       ':' expr01
  1429.     {
  1430.         upd_short(pop_address(), mem_block[A_PROGRAM].current_size);
  1431.         if (exact_types && !compatible_types($4, $7)) {
  1432.         type_error("Different types in ?: expr", $4);
  1433.         type_error("                      and ", $7);
  1434.         }
  1435.         if ($4 == TYPE_ANY) $$ = $7;
  1436.         else if ($7 == TYPE_ANY) $$ = $4;
  1437.         else if (TYPE($4, TYPE_MOD_POINTER|TYPE_ANY)) $$ = $7;
  1438.         else if (TYPE($7, TYPE_MOD_POINTER|TYPE_ANY)) $$ = $4;
  1439.         else $$ = $4;
  1440.     };
  1441.  
  1442. assign: '=' { $$ = F_ASSIGN; }
  1443.       | F_AND_EQ { $$ = F_AND_EQ; }
  1444.       | F_OR_EQ { $$ = F_OR_EQ; }
  1445.       | F_XOR_EQ { $$ = F_XOR_EQ; }
  1446.       | F_LSH_EQ { $$ = F_LSH_EQ; }
  1447.       | F_RSH_EQ { $$ = F_RSH_EQ; }
  1448.       | F_ADD_EQ { $$ = F_ADD_EQ; }
  1449.       | F_SUB_EQ { $$ = F_SUB_EQ; }
  1450.       | F_MULT_EQ { $$ = F_MULT_EQ; }
  1451.       | F_MOD_EQ { $$ = F_MOD_EQ; }
  1452.       | F_DIV_EQ { $$ = F_DIV_EQ; };
  1453.  
  1454. return: F_RETURN
  1455.     {
  1456.         if (exact_types && !TYPE(exact_types, TYPE_VOID))
  1457.         type_error("Must return a value for a function declared",
  1458.                exact_types);
  1459.         ins_f_byte(F_CONST0);
  1460.         ins_f_byte(F_RETURN);
  1461.     }
  1462.       | F_RETURN comma_expr
  1463.     {
  1464.         if (exact_types && !TYPE($2, exact_types & TYPE_MOD_MASK))
  1465.         type_error("Return type not matching", exact_types);
  1466.         ins_f_byte(F_RETURN);
  1467.     };
  1468.  
  1469. expr_list: /* empty */        { $$ = 0; }
  1470.      | expr_list2        { $$ = $1; }
  1471.      | expr_list2 ','    { $$ = $1; } ; /* Allow a terminating comma */
  1472.  
  1473. expr_list2: expr0        { $$ = 1; add_arg_type($1); }
  1474.          | expr_list2 ',' expr0    { $$ = $1 + 1; add_arg_type($3); } ;
  1475.  
  1476. expr1: expr2 { $$ = $1; }
  1477.      | expr2 F_LOR
  1478.     {
  1479.         ins_f_byte(F_DUP); ins_f_byte(F_JUMP_WHEN_NON_ZERO);
  1480.         push_address();
  1481.         ins_short(0);
  1482.         ins_f_byte(F_POP_VALUE);
  1483.     }
  1484.        expr1
  1485.     {
  1486.         upd_short(pop_address(), mem_block[A_PROGRAM].current_size);
  1487.         if ($1 == $4)
  1488.         $$ = $1;
  1489.         else
  1490.         $$ = TYPE_ANY;    /* Return type can't be known */
  1491.     };
  1492.  
  1493. expr2: expr211 { $$ = $1; }
  1494.      | expr211 F_LAND
  1495.     {
  1496.         ins_f_byte(F_DUP); ins_f_byte(F_JUMP_WHEN_ZERO);
  1497.         push_address();
  1498.         ins_short(0);
  1499.         ins_f_byte(F_POP_VALUE);
  1500.     }
  1501.        expr2
  1502.     {
  1503.         upd_short(pop_address(), mem_block[A_PROGRAM].current_size);
  1504.         if ($1 == $4)
  1505.         $$ = $1;
  1506.         else
  1507.         $$ = TYPE_ANY;    /* Return type can't be known */
  1508.     } ;
  1509.  
  1510. expr211: expr212
  1511.        | expr211 '|' expr212
  1512.           {
  1513.           if (exact_types && !TYPE($1,TYPE_NUMBER))
  1514.           type_error("Bad argument 1 to |", $1);
  1515.           if (exact_types && !TYPE($3,TYPE_NUMBER))
  1516.           type_error("Bad argument 2 to |", $3);
  1517.           $$ = TYPE_NUMBER;
  1518.           ins_f_byte(F_OR);
  1519.       };
  1520.  
  1521. expr212: expr213
  1522.        | expr212 '^' expr213
  1523.       {
  1524.           if (exact_types && !TYPE($1,TYPE_NUMBER))
  1525.           type_error("Bad argument 1 to ^", $1);
  1526.           if (exact_types && !TYPE($3,TYPE_NUMBER))
  1527.           type_error("Bad argument 2 to ^", $3);
  1528.           $$ = TYPE_NUMBER;
  1529.           ins_f_byte(F_XOR);
  1530.       };
  1531.  
  1532. expr213: expr22
  1533.        | expr213 '&' expr22
  1534.       {
  1535.           ins_f_byte(F_AND);
  1536.           if ( !TYPE($1,TYPE_MOD_POINTER) || !TYPE($3,TYPE_MOD_POINTER) ) {
  1537.               if (exact_types && !TYPE($1,TYPE_NUMBER))
  1538.               type_error("Bad argument 1 to &", $1);
  1539.               if (exact_types && !TYPE($3,TYPE_NUMBER))
  1540.               type_error("Bad argument 2 to &", $3);
  1541.           }
  1542.           $$ = TYPE_NUMBER;
  1543.       };
  1544.  
  1545. expr22: expr23
  1546.       | expr24 F_EQ expr24
  1547.     {
  1548.         int t1 = $1 & TYPE_MOD_MASK, t2 = $3 & TYPE_MOD_MASK;
  1549.         if (exact_types && t1 != t2 && t1 != TYPE_ANY && t2 != TYPE_ANY) {
  1550.         type_error("== always false because of different types", $1);
  1551.         type_error("                               compared to", $3);
  1552.         }
  1553.         ins_f_byte(F_EQ);
  1554.         $$ = TYPE_NUMBER;
  1555.     };
  1556.       | expr24 F_NE expr24
  1557.     {
  1558.         int t1 = $1 & TYPE_MOD_MASK, t2 = $3 & TYPE_MOD_MASK;
  1559.         if (exact_types && t1 != t2 && t1 != TYPE_ANY && t2 != TYPE_ANY) {
  1560.         type_error("!= always true because of different types", $1);
  1561.         type_error("                               compared to", $3);
  1562.         }
  1563.         ins_f_byte(F_NE);
  1564.         $$ = TYPE_NUMBER;
  1565.     };
  1566.  
  1567. expr23: expr24
  1568.       | expr24 '>' expr24
  1569.     { $$ = TYPE_NUMBER; ins_f_byte(F_GT); };
  1570.       | expr24 F_GE expr24
  1571.     { $$ = TYPE_NUMBER; ins_f_byte(F_GE); };
  1572.       | expr24 '<' expr24
  1573.     { $$ = TYPE_NUMBER; ins_f_byte(F_LT); };
  1574.       | expr24 F_LE expr24
  1575.     { $$ = TYPE_NUMBER; ins_f_byte(F_LE); };
  1576.  
  1577. expr24: expr25
  1578.       | expr24 F_LSH expr25
  1579.     {
  1580.         ins_f_byte(F_LSH);
  1581.         $$ = TYPE_NUMBER;
  1582.         if (exact_types && !TYPE($1, TYPE_NUMBER))
  1583.         type_error("Bad argument number 1 to '<<'", $1);
  1584.         if (exact_types && !TYPE($3, TYPE_NUMBER))
  1585.         type_error("Bad argument number 2 to '<<'", $3);
  1586.     };
  1587.       | expr24 F_RSH expr25
  1588.     {
  1589.         ins_f_byte(F_RSH);
  1590.         $$ = TYPE_NUMBER;
  1591.         if (exact_types && !TYPE($1, TYPE_NUMBER))
  1592.         type_error("Bad argument number 1 to '>>'", $1);
  1593.         if (exact_types && !TYPE($3, TYPE_NUMBER))
  1594.         type_error("Bad argument number 2 to '>>'", $3);
  1595.     };
  1596.  
  1597. expr25: expr27
  1598.       | expr25 '+' expr27    /* Type checks of this case is complicated */
  1599.     { ins_f_byte(F_ADD); $$ = TYPE_ANY; };
  1600.       | expr25 '-' expr27
  1601.     {
  1602.         int bad_arg = 0;
  1603.  
  1604.         if (exact_types) {
  1605.         if (!TYPE($1, TYPE_NUMBER) && !($1 & TYPE_MOD_POINTER) ) {
  1606.                     type_error("Bad argument number 1 to '-'", $1);
  1607.             bad_arg++;
  1608.         }
  1609.         if (!TYPE($3, TYPE_NUMBER) && !($3 & TYPE_MOD_POINTER) ) {
  1610.                     type_error("Bad argument number 2 to '-'", $3);
  1611.             bad_arg++;
  1612.         }
  1613.         }
  1614.         $$ = TYPE_ANY;
  1615.         if (($1 & TYPE_MOD_POINTER) || ($3 & TYPE_MOD_POINTER))
  1616.         $$ = TYPE_MOD_POINTER | TYPE_ANY;
  1617.         if (!($1 & TYPE_MOD_POINTER) || !($3 & TYPE_MOD_POINTER)) {
  1618.         if (exact_types && $$ != TYPE_ANY && !bad_arg)
  1619.             yyerror("Arguments to '-' don't match");
  1620.         $$ = TYPE_NUMBER;
  1621.         }
  1622.         ins_f_byte(F_SUBTRACT);
  1623.     };
  1624.  
  1625. expr27: expr28
  1626.       | expr27 '*' expr3
  1627.     {
  1628.         if (exact_types && !TYPE($1, TYPE_NUMBER))
  1629.         type_error("Bad argument number 1 to '*'", $1);
  1630.         if (exact_types && !TYPE($3, TYPE_NUMBER))
  1631.         type_error("Bad argument number 2 to '*'", $3);
  1632.         ins_f_byte(F_MULTIPLY);
  1633.         $$ = TYPE_NUMBER;
  1634.     };
  1635.       | expr27 '%' expr3
  1636.     {
  1637.         if (exact_types && !TYPE($1, TYPE_NUMBER))
  1638.         type_error("Bad argument number 1 to '%'", $1);
  1639.         if (exact_types && !TYPE($3, TYPE_NUMBER))
  1640.         type_error("Bad argument number 2 to '%'", $3);
  1641.         ins_f_byte(F_MOD);
  1642.         $$ = TYPE_NUMBER;
  1643.     };
  1644.       | expr27 '/' expr3
  1645.     {
  1646.         if (exact_types && !TYPE($1, TYPE_NUMBER))
  1647.         type_error("Bad argument number 1 to '/'", $1);
  1648.         if (exact_types && !TYPE($3, TYPE_NUMBER))
  1649.         type_error("Bad argument number 2 to '/'", $3);
  1650.         ins_f_byte(F_DIVIDE);
  1651.         $$ = TYPE_NUMBER;
  1652.     };
  1653.  
  1654. expr28: expr3
  1655.     | cast expr3
  1656.           {
  1657.           $$ = $1;
  1658.           if (exact_types && $2 != TYPE_ANY && $2 != TYPE_UNKNOWN &&
  1659.               $1 != TYPE_VOID)
  1660.               type_error("Casts are only legal for type mixed, or when unknown", $2);
  1661.           } ;
  1662.  
  1663. expr3: expr31
  1664.      | F_INC lvalue
  1665.         {
  1666.         ins_f_byte(F_INC);
  1667.         if (exact_types && !TYPE($2, TYPE_NUMBER))
  1668.         type_error("Bad argument to ++", $2);
  1669.         $$ = TYPE_NUMBER;
  1670.     };
  1671.      | F_DEC lvalue
  1672.         {
  1673.         ins_f_byte(F_DEC);
  1674.         if (exact_types && !TYPE($2, TYPE_NUMBER))
  1675.         type_error("Bad argument to --", $2);
  1676.         $$ = TYPE_NUMBER;
  1677.     };
  1678.      | F_NOT expr3
  1679.     {
  1680.         ins_f_byte(F_NOT);    /* Any type is valid here. */
  1681.         $$ = TYPE_NUMBER;
  1682.     };
  1683.      | '~' expr3
  1684.     {
  1685.         ins_f_byte(F_COMPL);
  1686.         if (exact_types && !TYPE($2, TYPE_NUMBER))
  1687.         type_error("Bad argument to ~", $2);
  1688.         $$ = TYPE_NUMBER;
  1689.     };
  1690.      | '-' expr3
  1691.     {
  1692.         ins_f_byte(F_NEGATE);
  1693.         if (exact_types && !TYPE($2, TYPE_NUMBER))
  1694.         type_error("Bad argument to unary '-'", $2);
  1695.         $$ = TYPE_NUMBER;
  1696.     };
  1697.  
  1698. expr31: expr4
  1699.       | lvalue F_INC
  1700.          {
  1701.          ins_f_byte(F_POST_INC);
  1702.          if (exact_types && !TYPE($1, TYPE_NUMBER))
  1703.          type_error("Bad argument to ++", $1);
  1704.          $$ = TYPE_NUMBER;
  1705.      };
  1706.       | lvalue F_DEC
  1707.          {
  1708.          ins_f_byte(F_POST_DEC);
  1709.          if (exact_types && !TYPE($1, TYPE_NUMBER))
  1710.          type_error("Bad argument to --", $1);
  1711.          $$ = TYPE_NUMBER;
  1712.      };
  1713.  
  1714. expr4: function_call
  1715.      | lvalue
  1716.     {
  1717.         int pos = mem_block[A_PROGRAM].current_size;
  1718.         /* Some optimization. Replace the push-lvalue with push-value */
  1719.         if (last_push_identifier == pos-2)
  1720.         mem_block[A_PROGRAM].block[last_push_identifier] =
  1721.             F_IDENTIFIER - F_OFFSET;
  1722.         else if (last_push_local == pos-2)
  1723.         mem_block[A_PROGRAM].block[last_push_local] =
  1724.             F_LOCAL_NAME - F_OFFSET;
  1725.         else if (last_push_indexed == pos-1)
  1726.         mem_block[A_PROGRAM].block[last_push_indexed] =
  1727.             F_INDEX - F_OFFSET;
  1728.         else if (last_push_indexed != 0)
  1729.         fatal("Should be a push at this point !\n");
  1730.         $$ = $1;
  1731.     }
  1732.      | string | number
  1733.      | '(' comma_expr ')' { $$ = $2; }
  1734.      | catch { $$ = TYPE_ANY; }
  1735.      | sscanf { $$ = TYPE_NUMBER; }
  1736.      | parse_command { $$ = TYPE_NUMBER; }
  1737.      | '(' '{' expr_list '}' ')'
  1738.        {
  1739.        pop_arg_stack($3);        /* We don't care about these types */
  1740.        ins_f_byte(F_AGGREGATE);
  1741.        ins_short($3);
  1742.        $$ = TYPE_MOD_POINTER | TYPE_ANY;
  1743.        };
  1744.  
  1745. catch: F_CATCH { ins_f_byte(F_CATCH); push_address(); ins_short(0);}
  1746.        '(' comma_expr ')'
  1747.            {
  1748.            ins_f_byte(F_POP_VALUE);
  1749. #if 1
  1750.            ins_f_byte(F_CONST0);
  1751.            ins_f_byte(F_THROW);
  1752. #else
  1753.            ins_f_byte(F_RETURN);
  1754. #endif
  1755.            upd_short(pop_address(),
  1756.                  mem_block[A_PROGRAM].current_size);
  1757.            };
  1758.  
  1759. sscanf: F_SSCANF '(' expr0 ',' expr0 lvalue_list ')'
  1760.     {
  1761.         ins_f_byte(F_SSCANF); ins_byte($6 + 2);
  1762.     }
  1763.  
  1764. parse_command: F_PARSE_COMMAND '(' expr0 ',' expr0 ',' expr0 lvalue_list ')'
  1765.     {
  1766.         ins_f_byte(F_PARSE_COMMAND); ins_byte($8 + 3);
  1767.     }
  1768.  
  1769. lvalue_list: /* empty */ { $$ = 0; }
  1770.        | ',' lvalue lvalue_list { $$ = 1 + $3; } ;
  1771.  
  1772. lvalue: F_IDENTIFIER
  1773.     {
  1774.         int i = verify_declared($1);
  1775.         last_push_identifier = mem_block[A_PROGRAM].current_size;
  1776.         ins_f_byte(F_PUSH_IDENTIFIER_LVALUE);
  1777.         ins_byte(i);
  1778.         free($1);
  1779.         if (i == -1)
  1780.         $$ = TYPE_ANY;
  1781.         else
  1782.         $$ = VARIABLE(i)->type & TYPE_MOD_MASK;
  1783.     }
  1784.         | F_LOCAL_NAME
  1785.     {
  1786.         last_push_local = mem_block[A_PROGRAM].current_size;
  1787.         ins_f_byte(F_PUSH_LOCAL_VARIABLE_LVALUE);
  1788.         ins_byte($1);
  1789.         $$ = type_of_locals[$1];
  1790.     }
  1791.     | expr4 '[' comma_expr F_RANGE comma_expr ']'
  1792.       {
  1793.           ins_f_byte(F_RANGE);
  1794.           last_push_indexed = 0;
  1795.           if (exact_types) {
  1796.           if (($1 & TYPE_MOD_POINTER) == 0 && !TYPE($1, TYPE_STRING))
  1797.               type_error("Bad type to indexed value", $1);
  1798.           if (!TYPE($3, TYPE_NUMBER))
  1799.               type_error("Bad type of index", $3);
  1800.           if (!TYPE($5, TYPE_NUMBER))
  1801.               type_error("Bad type of index", $5);
  1802.           }
  1803.           if ($1 == TYPE_ANY)
  1804.           $$ = TYPE_ANY;
  1805.           else if (TYPE($1, TYPE_STRING))
  1806.           $$ = TYPE_STRING;
  1807.           else if ($1 & TYPE_MOD_POINTER)
  1808.           $$ = $1;
  1809.           else if (exact_types)
  1810.           type_error("Bad type of argument used for range", $1);
  1811.       };
  1812.     | expr4 '[' comma_expr ']'
  1813.       {
  1814.           last_push_indexed = mem_block[A_PROGRAM].current_size;
  1815.           ins_f_byte(F_PUSH_INDEXED_LVALUE);
  1816.           if (exact_types) {
  1817.           if (($1 & TYPE_MOD_POINTER) == 0 && !TYPE($1, TYPE_STRING))
  1818.               type_error("Bad type to indexed value", $1);
  1819.           if (!TYPE($3, TYPE_NUMBER))
  1820.               type_error("Bad type of index", $3);
  1821.           }
  1822.           if ($1 == TYPE_ANY)
  1823.           $$ = TYPE_ANY;
  1824.           else if (TYPE($1, TYPE_STRING))
  1825.           $$ = TYPE_NUMBER;
  1826.           else
  1827.           $$ = $1 & TYPE_MOD_MASK & ~TYPE_MOD_POINTER;
  1828.       };
  1829.  
  1830. string: F_STRING
  1831.     {
  1832.         ins_f_byte(F_STRING);
  1833.         ins_short(store_prog_string($1));
  1834.         free($1);
  1835.         $$ = TYPE_STRING;
  1836.     };
  1837.  
  1838. string_constant: string_con1
  1839.         {
  1840.             char *p = make_shared_string($1);
  1841.             free($1);
  1842.             $$ = p;
  1843.         };
  1844.  
  1845. string_con1: F_STRING
  1846.        | string_con1 '+' F_STRING
  1847.     {
  1848.         $$ = xalloc( strlen($1) + strlen($3) + 1 );
  1849.         strcpy($$, $1);
  1850.         strcat($$, $3);
  1851.         free($1);
  1852.         free($3);
  1853.     };
  1854.  
  1855. function_call: function_name
  1856.     {
  1857.     /* This seems to be an ordinary function call. But, if the function
  1858.      * is not defined, then it might be a call to a simul_efun.
  1859.      * If it is, then we make it a call_other(), which requires the
  1860.      * function name as argument.
  1861.      * We have to remember until after parsing the arguments if it was
  1862.      * a simulated efun or not, which means that the pointer has to be
  1863.      * pushed on a stack. Use the internal yacc stack for this purpose.
  1864.      */
  1865.     $<funp>$ = 0;
  1866.     if (defined_function($1) == -1) {
  1867.         char *p = make_shared_string($1);
  1868.         $<funp>$ = find_simul_efun(p);
  1869.         if ($<funp>$ && !($<funp>$->type & TYPE_MOD_STATIC)) {
  1870.         ins_f_byte(F_STRING);
  1871.         ins_short(store_prog_string(
  1872.                   query_simul_efun_file_name()));
  1873.         ins_f_byte(F_STRING);
  1874.         ins_short(store_prog_string(p));
  1875.         } else {
  1876.         $<funp>$ = 0;
  1877.         }
  1878.         free_string(p);
  1879.     }
  1880.     }
  1881.     '(' expr_list ')'
  1882.     { 
  1883.     int f;
  1884.     int efun_override = strncmp($1, "efun::", 6) == 0;
  1885.  
  1886.     if ($<funp>2) {
  1887.         ins_f_byte(F_CALL_OTHER);
  1888.         ins_byte($4 + 2);
  1889.         $$ = $<funp>2->type;
  1890.     } else if (!efun_override && (f = defined_function($1)) >= 0) {
  1891.         struct function *funp;
  1892.         ins_f_byte(F_CALL_FUNCTION_BY_ADDRESS); ins_short(f);
  1893.         ins_byte($4);    /* Actual number of arguments */
  1894.         funp = FUNCTION(f);
  1895.         if (funp->flags & NAME_UNDEFINED)
  1896.         find_inherited(funp);
  1897.         /*
  1898.          * Verify that the function has been defined already.
  1899.          */
  1900.         if ((funp->flags & NAME_UNDEFINED) &&
  1901.         !(funp->flags & NAME_PROTOTYPE) && exact_types)
  1902.         {
  1903.         char buff[100];
  1904.         sprintf(buff, "Function %.50s undefined", funp->name);
  1905.         yyerror(buff);
  1906.         }
  1907.         $$ = funp->type & TYPE_MOD_MASK;
  1908.         /*
  1909.          * Check number of arguments.
  1910.          */
  1911.         if (funp->num_arg != $4 && !(funp->type & TYPE_MOD_VARARGS) &&
  1912.         (funp->flags & NAME_STRICT_TYPES) && exact_types)
  1913.         {
  1914.         char buff[100];
  1915.         sprintf(buff, "Wrong number of arguments to %.60s", $1);
  1916.         yyerror(buff);
  1917.         }
  1918.         /*
  1919.          * Check the argument types.
  1920.          */
  1921.         if (exact_types && *(unsigned short *)&mem_block[A_ARGUMENT_INDEX].block[f * sizeof (unsigned short)] != INDEX_START_NONE)
  1922.         {
  1923.         int i, first;
  1924.         unsigned short *arg_types;
  1925.         
  1926.         arg_types = (unsigned short *)
  1927.             mem_block[A_ARGUMENT_TYPES].block;
  1928.         first = *(unsigned short *)&mem_block[A_ARGUMENT_INDEX].block[f * sizeof (unsigned short)];
  1929.         for (i=0; i < funp->num_arg && i < $4; i++) {
  1930.             int tmp = get_argument_type(i, $4);
  1931.             if (!TYPE(tmp, arg_types[first + i])) {
  1932.             char buff[100];
  1933.             sprintf(buff, "Bad type for argument %d %s", i+1,
  1934.                 get_two_types(arg_types[first+i], tmp));
  1935.             yyerror(buff);
  1936.             }
  1937.         }
  1938.         }
  1939.     } else if (efun_override || (f = lookup_predef($1)) != -1) {
  1940.         int min, max, def, *argp;
  1941.         extern int efun_arg_types[];
  1942.  
  1943.         if (efun_override) {
  1944.         f = lookup_predef($1+6);
  1945.         }
  1946.         if (f == -1) {    /* Only possible for efun_override */
  1947.         char buff[100];
  1948.         sprintf(buff, "Unknown efun: %s", $1+6);
  1949.         yyerror(buff);
  1950.         } else {
  1951.         min = instrs[f-F_OFFSET].min_arg;
  1952.         max = instrs[f-F_OFFSET].max_arg;
  1953.         def = instrs[f-F_OFFSET].Default;
  1954.         $$ = instrs[f-F_OFFSET].ret_type;
  1955.         argp = &efun_arg_types[instrs[f-F_OFFSET].arg_index];
  1956.         if (def && $4 == min-1) {
  1957.             ins_f_byte(def);
  1958.             max--;
  1959.             min--;
  1960.         } else if ($4 < min) {
  1961.             char bff[100];
  1962.             sprintf(bff, "Too few arguments to %s",
  1963.                 instrs[f-F_OFFSET].name);
  1964.             yyerror(bff);
  1965.         } else if ($4 > max && max != -1) {
  1966.             char bff[100];
  1967.             sprintf(bff, "Too many arguments to %s",
  1968.                 instrs[f-F_OFFSET].name);
  1969.             yyerror(bff);
  1970.         } else if (max != -1 && exact_types) {
  1971.             /*
  1972.              * Now check all types of the arguments to efuns.
  1973.              */
  1974.             int i, argn;
  1975.             char buff[100];
  1976.             for (argn=0; argn < $4; argn++) {
  1977.             int tmp = get_argument_type(argn, $4);
  1978.             for(i=0; !TYPE(argp[i], tmp) && argp[i] != 0; i++)
  1979.                 ;
  1980.             if (argp[i] == 0) {
  1981.                 sprintf(buff, "Bad argument %d type to efun %s()",
  1982.                     argn+1, instrs[f-F_OFFSET].name);
  1983.                 yyerror(buff);
  1984.             }
  1985.             while(argp[i] != 0)
  1986.                 i++;
  1987.             argp += i + 1;
  1988.             }
  1989.         }
  1990.         ins_f_byte(f);
  1991.         /* Only store number of arguments for instructions
  1992.          * that allowed a variable number.
  1993.          */
  1994.         if (max != min)
  1995.             ins_byte($4);/* Number of actual arguments */
  1996.         }
  1997.     } else {
  1998.         struct function *funp;
  1999.  
  2000.         f = define_new_function($1, 0, 0, 0, NAME_UNDEFINED, 0);
  2001.         ins_f_byte(F_CALL_FUNCTION_BY_ADDRESS);
  2002.         ins_short(f);
  2003.         ins_byte($4);    /* Number of actual arguments */
  2004.         funp = FUNCTION(f);
  2005.         if (strchr($1, ':')) {
  2006.         /*
  2007.          * A function defined by inheritance. Find
  2008.          * real definition immediately.
  2009.          */
  2010.         find_inherited(funp);
  2011.         }
  2012.         /*
  2013.          * Check if this function has been defined.
  2014.          * But, don't complain yet about functions defined
  2015.          * by inheritance.
  2016.          */
  2017.         if (exact_types && (funp->flags & NAME_UNDEFINED)) {
  2018.         char buff[100];
  2019.         sprintf(buff, "Undefined function %.50s", $1);
  2020.         yyerror(buff);
  2021.         }
  2022.         if (!(funp->flags & NAME_UNDEFINED))
  2023.         $$ = funp->type;
  2024.         else
  2025.         $$ = TYPE_ANY;    /* Just a guess */
  2026.     }
  2027.     free($1);
  2028.     pop_arg_stack($4);    /* Argument types not needed more */
  2029.     }
  2030. | expr4 F_ARROW function_name
  2031.     {
  2032.     ins_f_byte(F_STRING);
  2033.     ins_short(store_prog_string($3));
  2034.     free($3);
  2035.     }
  2036. '(' expr_list ')'
  2037.     {
  2038.     ins_f_byte(F_CALL_OTHER);
  2039.     ins_byte($6 + 2);
  2040.     $$ = TYPE_UNKNOWN;
  2041.     pop_arg_stack($6);    /* No good need of these arguments */
  2042.     };
  2043.  
  2044. function_name: F_IDENTIFIER
  2045.          | F_COLON_COLON F_IDENTIFIER
  2046.         {
  2047.             char *p = xalloc(strlen($2) + 3);
  2048.             strcpy(p, "::"); strcat(p, $2); free($2);
  2049.             $$ = p;
  2050.         }
  2051.           | F_IDENTIFIER F_COLON_COLON F_IDENTIFIER
  2052.         {
  2053.             char *p = xalloc(strlen($1) + strlen($3) + 3);
  2054.             strcpy(p, $1); strcat(p, "::"); strcat(p, $3);
  2055.             free($1); free($3);
  2056.             $$ = p;
  2057.         };
  2058.  
  2059. cond: condStart
  2060.       statement
  2061.     {
  2062.         int i;
  2063.         i = pop_address();
  2064.         ins_f_byte(F_JUMP); push_address(); ins_short(0);
  2065.         upd_short(i, mem_block[A_PROGRAM].current_size);
  2066.     }
  2067.       optional_else_part
  2068.     { upd_short(pop_address(), mem_block[A_PROGRAM].current_size); } ;
  2069.  
  2070. condStart: F_IF '(' comma_expr ')'
  2071.     {
  2072.         ins_f_byte(F_JUMP_WHEN_ZERO);
  2073.         push_address();
  2074.         ins_short(0);
  2075.     } ;
  2076.  
  2077. optional_else_part: /* empty */
  2078.        | F_ELSE statement ;
  2079. %%
  2080.  
  2081. void yyerror(str)
  2082. char *str;
  2083. {
  2084.     extern int num_parse_error;
  2085.  
  2086.     if (num_parse_error > 5)
  2087.     return;
  2088.     (void)fprintf(stderr, "%s: %s line %d\n", current_file, str,
  2089.           current_line);
  2090.     fflush(stderr);
  2091.     smart_log(current_file, current_line, str);
  2092.     if (num_parse_error == 0)
  2093.     save_error(str, current_file, current_line);
  2094.     num_parse_error++;
  2095. }
  2096.  
  2097. static int check_declared(str)
  2098.     char *str;
  2099. {
  2100.     struct variable *vp;
  2101.     int offset;
  2102.  
  2103.     for (offset=0;
  2104.      offset < mem_block[A_VARIABLES].current_size;
  2105.      offset += sizeof (struct variable)) {
  2106.     vp = (struct variable *)&mem_block[A_VARIABLES].block[offset];
  2107.     if (vp->flags & NAME_HIDDEN)
  2108.         continue;
  2109.     if (strcmp(vp->name, str) == 0)
  2110.         return offset / sizeof (struct variable);
  2111.     }
  2112.     return -1;
  2113. }
  2114.  
  2115. static int verify_declared(str)
  2116.     char *str;
  2117. {
  2118.     int r;
  2119.  
  2120.     r = check_declared(str);
  2121.     if (r < 0) {
  2122.     char buff[100];
  2123.         (void)sprintf(buff, "Variable %s not declared !", str);
  2124.         yyerror(buff);
  2125.     return -1;
  2126.     }
  2127.     return r;
  2128. }
  2129.  
  2130. void free_all_local_names()
  2131. {
  2132.     int i;
  2133.  
  2134.     for (i=0; i<current_number_of_locals; i++) {
  2135.     free(local_names[i]);
  2136.     local_names[i] = 0;
  2137.     }
  2138.     current_number_of_locals = 0;
  2139.     current_break_stack_need = 0;
  2140.     max_break_stack_need = 0;
  2141. }
  2142.  
  2143. void add_local_name(str, type)
  2144.     char *str;
  2145.     int type;
  2146. {
  2147.     if (current_number_of_locals == MAX_LOCAL)
  2148.     yyerror("Too many local variables");
  2149.     else {
  2150.     type_of_locals[current_number_of_locals] = type;
  2151.     local_names[current_number_of_locals++] = str;
  2152.     }
  2153. }
  2154.  
  2155. /*
  2156.  * Copy all function definitions from an inherited object. They are added
  2157.  * as undefined, so that they can be redefined by a local definition.
  2158.  * If they are not redefined, then they will be updated, so that they
  2159.  * point to the inherited definition. See epilog(). Types will be copied
  2160.  * at that moment (if available).
  2161.  *
  2162.  * A call to an inherited function will not be
  2163.  * done through this entry (because this entry can be replaced by a new
  2164.  * definition). If an function defined by inheritance is called, then one
  2165.  * special definition will be made at first call.
  2166.  */
  2167. static int copy_functions(from, type)
  2168.     struct program *from;
  2169.     int type;
  2170. {
  2171.     int i, initializer = -1;
  2172.     unsigned short tmp_short;
  2173.  
  2174.     for (i=0; i < from->num_functions; i++) {
  2175.     /* Do not call define_new_function() from here, as duplicates would
  2176.      * be removed.
  2177.      */
  2178.     struct function fun;
  2179.     int new_type;
  2180.  
  2181.     fun = from->functions[i];    /* Make a copy */
  2182.     /* Prepare some data to be used if this function will not be
  2183.      * redefined.
  2184.      */
  2185.     if (strchr(fun.name, ':'))
  2186.         fun.flags |= NAME_HIDDEN;    /* Not to be used again ! */
  2187.     fun.name = make_shared_string(fun.name);    /* Incr ref count */
  2188.     fun.offset = mem_block[A_INHERITS].current_size /
  2189.         sizeof (struct inherit) - 1;
  2190.     fun.function_index_offset = i;
  2191.     if (fun.type & TYPE_MOD_NO_MASK) {
  2192.         int n;
  2193.         if ((n = defined_function(fun.name)) != -1 &&
  2194.         !(((struct function *)mem_block[A_FUNCTIONS].block)[n].flags &
  2195.           NAME_UNDEFINED))
  2196.         {
  2197.         char *p = (char *)alloca(80 + strlen(fun.name));
  2198.         sprintf(p, "Illegal to redefine 'nomask' function \"%s\"",
  2199.             fun.name);
  2200.         yyerror(p);
  2201.         }
  2202.         fun.flags |= NAME_INHERITED;
  2203.     } else if (!(fun.flags & NAME_HIDDEN)) {
  2204.         fun.flags |= NAME_UNDEFINED;
  2205.     }
  2206.     /*
  2207.      * public functions should not become private when inherited
  2208.      * 'private'
  2209.      */
  2210.     new_type = type;
  2211.     if (fun.type & TYPE_MOD_PUBLIC)
  2212.         new_type &= ~TYPE_MOD_PRIVATE;
  2213.     fun.type |= new_type;
  2214.     /* marion
  2215.      * this should make possible to inherit a heart beat function, and
  2216.      * thus to mask it if wanted.
  2217.      */
  2218.     if (heart_beat == -1 && fun.name[0] == 'h' &&
  2219.         strcmp(fun.name, "heart_beat") == 0)
  2220.     {
  2221.         heart_beat = mem_block[A_FUNCTIONS].current_size /
  2222.         sizeof (struct function);
  2223.     } else if (fun.name[0] == '_' && strcmp(fun.name, "__INIT") == 0) {
  2224.         initializer = i;
  2225.         fun.flags |= NAME_INHERITED;
  2226.     }
  2227.     add_to_mem_block(A_FUNCTIONS, (char *)&fun, sizeof fun);
  2228.     /*
  2229.      * Copy information about the types of the arguments, if it is
  2230.      * available.
  2231.      */
  2232.     tmp_short = INDEX_START_NONE;    /* Presume not available. */
  2233.     if (from->type_start != 0 && from->type_start[i] != INDEX_START_NONE)
  2234.     {
  2235.         int arg;
  2236.         /*
  2237.          * They are available for function number 'i'. Copy types of
  2238.          * all arguments, and remember where they started.
  2239.          */
  2240.         tmp_short = mem_block[A_ARGUMENT_TYPES].current_size /
  2241.         sizeof from->argument_types[0];
  2242.         for (arg = 0; arg < fun.num_arg; arg++) {
  2243.         add_to_mem_block(A_ARGUMENT_TYPES,
  2244.                  &from->argument_types[from->type_start[i]],
  2245.                  sizeof (unsigned short));
  2246.         }
  2247.     }
  2248.     /*
  2249.      * Save the index where they started. Every function will have an
  2250.      * index where the type info of arguments starts.
  2251.      */
  2252.     add_to_mem_block(A_ARGUMENT_INDEX, &tmp_short, sizeof tmp_short);
  2253.     }
  2254.     return initializer;
  2255. }
  2256.  
  2257. /*
  2258.  * Copy all variabel names from the object that is inherited from.
  2259.  * It is very important that they are stored in the same order with the
  2260.  * same index.
  2261.  */
  2262. static void copy_variables(from, type)
  2263.     struct program *from;
  2264.     int type;
  2265. {
  2266.     int i;
  2267.  
  2268.     for (i=0; i<from->num_variables; i++) {
  2269.     int new_type = type;
  2270.     int n = check_declared(from->variable_names[i].name);
  2271.  
  2272.     if (n != -1 && (VARIABLE(n)->type & TYPE_MOD_NO_MASK)) {
  2273.         char *p = (char *)alloca(80 +
  2274.                      strlen(from->variable_names[i].name));
  2275.         sprintf(p, "Illegal to redefine 'nomask' variable \"%s\"",
  2276.             VARIABLE(n)->name);
  2277.         yyerror(p);
  2278.     }
  2279.     /*
  2280.      * 'public' variables should not become private when inherited
  2281.      * 'private'.
  2282.      */
  2283.     if (from->variable_names[i].type & TYPE_MOD_PUBLIC)
  2284.         new_type &= ~TYPE_MOD_PRIVATE;
  2285.     define_variable(from->variable_names[i].name,
  2286.             from->variable_names[i].type | new_type,
  2287.             from->variable_names[i].type & TYPE_MOD_PRIVATE ?
  2288.                 NAME_HIDDEN : 0);
  2289.     }
  2290. }
  2291.  
  2292. /*
  2293.  * This function is called from lex.c for every new line read from the
  2294.  * "top" file (means not included files). Some new lines are missed,
  2295.  * as with #include statements, so it is compensated for.
  2296.  */
  2297. void store_line_number_info()
  2298. {
  2299.     unsigned short offset = mem_block[A_PROGRAM].current_size;
  2300.  
  2301.     while(mem_block[A_LINENUMBERS].current_size / sizeof (short) <
  2302.       current_line)
  2303.     {
  2304.     add_to_mem_block(A_LINENUMBERS, (char *)&offset, sizeof offset);
  2305.     }
  2306. }
  2307.  
  2308. static char *get_type_name(type)
  2309.     int type;
  2310. {
  2311.     static char buff[100];
  2312.     static char *type_name[] = { "unknown", "int", "string",
  2313.                      "void", "object", "mixed", };
  2314.     int pointer = 0;
  2315.  
  2316.     buff[0] = 0;
  2317.     if (type & TYPE_MOD_STATIC)
  2318.     strcat(buff, "static ");
  2319.     if (type & TYPE_MOD_NO_MASK)
  2320.     strcat(buff, "nomask ");
  2321.     if (type & TYPE_MOD_PRIVATE)
  2322.     strcat(buff, "private ");
  2323.     if (type & TYPE_MOD_PROTECTED)
  2324.     strcat(buff, "protected ");
  2325.     if (type & TYPE_MOD_PUBLIC)
  2326.     strcat(buff, "public ");
  2327.     if (type & TYPE_MOD_VARARGS)
  2328.     strcat(buff, "varargs ");
  2329.     type &= TYPE_MOD_MASK;
  2330.     if (type & TYPE_MOD_POINTER) {
  2331.     pointer = 1;
  2332.     type &= ~TYPE_MOD_POINTER;
  2333.     }
  2334.     if (type >= sizeof type_name / sizeof type_name[0])
  2335.     fatal("Bad type\n");
  2336.     strcat(buff, type_name[type]);
  2337.     strcat(buff," ");
  2338.     if (pointer)
  2339.     strcat(buff, "* ");
  2340.     return buff;
  2341. }
  2342.  
  2343. void type_error(str, type)
  2344.     char *str;
  2345.     int type;
  2346. {
  2347.     static char buff[100];
  2348.     char *p;
  2349.     p = get_type_name(type);
  2350.     if (strlen(str) + strlen(p) + 5 >= sizeof buff) {
  2351.     yyerror(str);
  2352.     } else {
  2353.     strcpy(buff, str);
  2354.     strcat(buff, ": \"");
  2355.     strcat(buff, p);
  2356.     strcat(buff, "\"");
  2357.     yyerror(buff);
  2358.     }
  2359. }
  2360.  
  2361. /*
  2362.  * Compile an LPC file.
  2363.  */
  2364. void compile_file() {
  2365.     int yyparse();
  2366.  
  2367.     prolog();
  2368.     yyparse();
  2369.     epilog();
  2370. }
  2371.  
  2372. static char *get_two_types(type1, type2)
  2373.     int type1, type2;
  2374. {
  2375.     static char buff[100];
  2376.  
  2377.     strcpy(buff, "( ");
  2378.     strcat(buff, get_type_name(type1));
  2379.     strcat(buff, "vs ");
  2380.     strcat(buff, get_type_name(type2));
  2381.     strcat(buff, ")");
  2382.     return buff;
  2383. }
  2384.  
  2385. /*
  2386.  * The program has been compiled. Prepare a 'struct program' to be returned.
  2387.  */
  2388. void epilog() {
  2389.     int size, i;
  2390.     char *p;
  2391.     struct function *funp;
  2392.     static int current_id_number = 1;
  2393.  
  2394. #ifdef DEBUG
  2395.     if (num_parse_error == 0 && type_of_arguments.current_size != 0)
  2396.     fatal("Failed to deallocate argument type stack\n");
  2397. #endif
  2398.     /*
  2399.      * Define the __INIT function, but only if there was any code
  2400.      * to initialize.
  2401.      */
  2402.     if (first_last_initializer_end != last_initializer_end) {
  2403.     define_new_function("__INIT", 0, 0, 0, 0, 0);
  2404.     /*
  2405.      * Change the last jump after the last initializer into a
  2406.      * return(1) statement.
  2407.      */
  2408.     mem_block[A_PROGRAM].block[last_initializer_end-1] =
  2409.         F_CONST1 - F_OFFSET;
  2410.     mem_block[A_PROGRAM].block[last_initializer_end-0] =
  2411.         F_RETURN - F_OFFSET;
  2412.     }
  2413.  
  2414.     /*
  2415.      * If functions are undefined, replace them by definitions done
  2416.      * by inheritance. All explicit "name::func" are already resolved.
  2417.      */
  2418.     for (i = 0; i < mem_block[A_FUNCTIONS].current_size; i += sizeof *funp) {
  2419.     funp = (struct function *)(mem_block[A_FUNCTIONS].block + i);
  2420.     if (!(funp->flags & NAME_UNDEFINED))
  2421.         continue;
  2422.     find_inherited(funp);
  2423.     }
  2424.     if (num_parse_error > 0) {
  2425.     prog = 0;
  2426.     for (i=0; i<NUMAREAS; i++)
  2427.         free(mem_block[i].block);
  2428.     return;
  2429.     }
  2430.     size = align(sizeof (struct program));
  2431.     for (i=0; i<NUMPAREAS; i++)
  2432.     size += align(mem_block[i].current_size);
  2433.     p = (char *)xalloc(size);
  2434.     prog = (struct program *)p;
  2435.     *prog = NULL_program;
  2436.     prog->total_size = size;
  2437.     prog->ref = 0;
  2438.     prog->heart_beat = heart_beat;
  2439.     prog->name = string_copy(current_file);
  2440.     prog->id_number = current_id_number++;
  2441.     total_prog_block_size += prog->total_size;
  2442.     total_num_prog_blocks += 1;
  2443.  
  2444.     p += align(sizeof (struct program));
  2445.     prog->program = p;
  2446.     if (mem_block[A_PROGRAM].current_size)
  2447.     memcpy(p, mem_block[A_PROGRAM].block,
  2448.            mem_block[A_PROGRAM].current_size);
  2449.     prog->program_size = mem_block[A_PROGRAM].current_size;
  2450.  
  2451.     p += align(mem_block[A_PROGRAM].current_size);
  2452.     prog->line_numbers = (unsigned short *)p;
  2453.     if (mem_block[A_LINENUMBERS].current_size)
  2454.     memcpy(p, mem_block[A_LINENUMBERS].block,
  2455.            mem_block[A_LINENUMBERS].current_size);
  2456.  
  2457.     p += align(mem_block[A_LINENUMBERS].current_size);
  2458.     prog->functions = (struct function *)p;
  2459.     prog->num_functions = mem_block[A_FUNCTIONS].current_size /
  2460.     sizeof (struct function);
  2461.     if (mem_block[A_FUNCTIONS].current_size)
  2462.     memcpy(p, mem_block[A_FUNCTIONS].block,
  2463.            mem_block[A_FUNCTIONS].current_size);
  2464.  
  2465.     p += align(mem_block[A_FUNCTIONS].current_size);
  2466.     prog->strings = (char **)p;
  2467.     prog->num_strings = mem_block[A_STRINGS].current_size /
  2468.     sizeof (char *);
  2469.     if (mem_block[A_STRINGS].current_size)
  2470.     memcpy(p, mem_block[A_STRINGS].block,
  2471.            mem_block[A_STRINGS].current_size);
  2472.  
  2473.     p += align(mem_block[A_STRINGS].current_size);
  2474.     prog->variable_names = (struct variable *)p;
  2475.     prog->num_variables = mem_block[A_VARIABLES].current_size /
  2476.     sizeof (struct variable);
  2477.     if (mem_block[A_VARIABLES].current_size)
  2478.     memcpy(p, mem_block[A_VARIABLES].block,
  2479.            mem_block[A_VARIABLES].current_size);
  2480.  
  2481.     p += align(mem_block[A_VARIABLES].current_size);
  2482.     prog->num_inherited = mem_block[A_INHERITS].current_size /
  2483.     sizeof (struct inherit);
  2484.     if (prog->num_inherited) {
  2485.     memcpy(p, mem_block[A_INHERITS].block,
  2486.            mem_block[A_INHERITS].current_size);
  2487.     prog->inherit = (struct inherit *)p;
  2488.     } else
  2489.     prog->inherit = 0;
  2490.     
  2491.     prog->argument_types = 0;    /* For now. Will be fixed someday */
  2492.  
  2493.     prog->type_start = 0;
  2494.     for (i=0; i<NUMAREAS; i++)
  2495.         free((char *)mem_block[i].block);
  2496.  
  2497.     /*  marion
  2498.     Do referencing here - avoid multiple referencing when an object
  2499.     inherits more than one object and one of the inherited is already
  2500.     loaded and not the last inherited
  2501.     */
  2502.     reference_prog (prog, "epilog");
  2503.     for (i = 0; i < prog->num_inherited; i++) {
  2504.     reference_prog (prog->inherit[i].prog, "inheritance");
  2505.     }
  2506. }
  2507.  
  2508. /*
  2509.  * Initialize the environment that the compiler needs.
  2510.  */
  2511. static void prolog() {
  2512.     int i;
  2513.  
  2514.     if (type_of_arguments.block == 0) {
  2515.     type_of_arguments.max_size = 100;
  2516.     type_of_arguments.block = xalloc(type_of_arguments.max_size);
  2517.     }
  2518.     type_of_arguments.current_size = 0;
  2519.     approved_object = 0;
  2520.     last_push_indexed = -1;
  2521.     last_push_local = -1;
  2522.     last_push_identifier = -1;
  2523.     prog = 0;        /* 0 means fail to load. */
  2524.     heart_beat = -1;
  2525.     comp_stackp = 0;    /* Local temp stack used by compiler */
  2526.     current_continue_address = 0;
  2527.     current_break_address = 0;
  2528.     num_parse_error = 0;
  2529.     free_all_local_names();    /* In case of earlier error */
  2530.     /* Initialize memory blocks where the result of the compilation
  2531.      * will be stored.
  2532.      */
  2533.     for (i=0; i < NUMAREAS; i++) {
  2534.     mem_block[i].block = xalloc(START_BLOCK_SIZE);
  2535.     mem_block[i].current_size = 0;
  2536.     mem_block[i].max_size = START_BLOCK_SIZE;
  2537.     }
  2538.     add_new_init_jump();
  2539.     first_last_initializer_end = last_initializer_end;
  2540. }
  2541.  
  2542. /*
  2543.  * Add a trailing jump after the last initialization code.
  2544.  */
  2545. void add_new_init_jump() {
  2546.     /*
  2547.      * Add a new jump.
  2548.      */
  2549.     ins_f_byte(F_JUMP);
  2550.     last_initializer_end = mem_block[A_PROGRAM].current_size;
  2551.     ins_short(0);
  2552. }
  2553.